diff --git a/README.md b/README.md index 7eecc0ab7c..f54b2ca296 100644 --- a/README.md +++ b/README.md @@ -128,12 +128,12 @@ sensible, or otherwise have a simple way to refer to it. To run a node: ```bash -chainweb-node --node-id=0 --config-file=./scripts/test-bootstrap-node.config +chainweb-node --node-id=0 --config-file=./tools/run-nodes/test-bootstrap-node.config ``` This will run a local "bootstrap" node on your machine. Its runtime options - as well as a hard-coded SSL certificate - are found in -`./scripts/test-bootstrap-node.config`. Further nodes can be ran with a simple: +`./tools/run-nodes/test-bootstrap-node.config`. Further nodes can be ran with a simple: ```bash chainweb-node --node-id=NID @@ -143,19 +143,23 @@ chainweb-node --node-id=NID loopback network. The default `--port` value is 0, which causes the node to request a free port from the operating system. -Alternatively, the directory `scripts` contains a shell script for starting a -network of `chainweb-node`s and collecting the logs from all nodes: +Alternatively, we provide an additional script - `run-nodes` - for starting a +network of `chainweb-node`s and collecting the logs from each: ```bash -# create directory for log files +# Create directory for log files. mkdir -p tmp/run-nodes-logs -# the first argument is the path to the chainweb-node binary -./scripts/run-nodes.sh ./chainweb-node 10 ./tmp/run-nodes-logs +# By default, run 10 nodes locally. +run-nodes --exe=path/to/chainweb-node -- --telemetry-log-handle=file:./tmp/run-nodes-logs -# stop all nodes with Ctrl-C +# Stop all nodes with Ctrl-C ``` +Any option after `--` will be passed as-is to each `chainweb-node` instance. + +See `run-nodes --help` for a complete list of its options. + ### Details A chainweb-node has two identifiers: diff --git a/bench/Bench.hs b/bench/Bench.hs index 9aa4c7af1a..ccfbf8c2a7 100644 --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -22,13 +22,13 @@ import System.IO (hFlush, stdout) import Chainweb.BlockHeader (BlockHeader(..), testBlockHeaders) import Chainweb.BlockHeader.Genesis (genesisBlockHeader) -import Chainweb.ChainId (ChainId, unsafeChainId) +import Chainweb.ChainId (ChainId) import Chainweb.Graph (singletonChainGraph) import Chainweb.Store.Git import Chainweb.Store.Git.Internal (leaves', lockGitStore) import Chainweb.TreeDB import Chainweb.Utils (withTempDir) -import Chainweb.Version (ChainwebVersion(..)) +import Chainweb.Version (ChainwebVersion(..), someChainId) --- @@ -115,11 +115,12 @@ branches gs leaf = -- Borrowed from Chainweb.Test.Utils +toyVersion :: ChainwebVersion +toyVersion = Test singletonChainGraph + genesis :: BlockHeader -genesis = toyGenesis chainId0 +genesis = toyGenesis $ someChainId toyVersion toyGenesis :: ChainId -> BlockHeader -toyGenesis cid = genesisBlockHeader (Test singletonChainGraph) cid +toyGenesis cid = genesisBlockHeader toyVersion cid -chainId0 :: ChainId -chainId0 = unsafeChainId 0 diff --git a/chainweb.cabal b/chainweb.cabal index d15ca4e10b..b4739e7b56 100644 --- a/chainweb.cabal +++ b/chainweb.cabal @@ -88,6 +88,8 @@ library , Chainweb.BlockHeader.Genesis , Chainweb.BlockHeader.Genesis.Testnet00 , Chainweb.BlockHeader.Genesis.Testnet00Payload + , Chainweb.BlockHeader.Genesis.Testnet01 + , Chainweb.BlockHeader.Genesis.Testnet01Payload , Chainweb.BlockHeader.Validation , Chainweb.BlockHeaderDB , Chainweb.BlockHeaderDB.RestAPI @@ -102,6 +104,7 @@ library , Chainweb.Counter , Chainweb.Crypto.MerkleLog , Chainweb.Cut + , Chainweb.Cut.Test , Chainweb.Cut.CutHashes , Chainweb.CutDB , Chainweb.CutDB.RestAPI @@ -260,7 +263,7 @@ library , ixset-typed >= 0.4 , lens >= 4.16 , loglevel >= 0.1 - , massiv >= 0.2 + , massiv >= 0.3 , memory >= 0.14 , memory >=0.14 , merkle-log @@ -274,6 +277,7 @@ library , paths >= 0.2 , pem >=0.2 , psqueues >= 0.2.7.0 + , raw-strings-qq >= 1.0 , quickcheck-instances >= 0.3 , random >= 1.1 , random-bytestring >= 0.1 @@ -403,7 +407,7 @@ test-suite chainweb-tests , http-types >= 0.12 , lens >= 4.16 , loglevel >= 0.1 - , massiv >= 0.2 + , massiv >= 0.3 , mtl >= 2.2 , mwc-random >= 0.13 , neat-interpolation >= 0.3 @@ -419,6 +423,7 @@ test-suite chainweb-tests , resourcet >= 1.2 , safe >= 0.3 , scientific >= 0.3 + , servant >= 0.14 , servant-client >= 0.14 , servant-client-core >= 0.14 , string-conv >= 0.1 @@ -561,6 +566,7 @@ executable slow-tests , deepseq >= 1.4 , directory >= 1.2 , extra >= 1.6 + , exceptions >= 0.8 , filepath >= 1.4 , extra >= 1.6 , fgl >= 5.6 @@ -570,7 +576,7 @@ executable slow-tests , io-streams >= 1.5 , lens >= 4.16 , loglevel >= 0.1 - , massiv >= 0.2 + , massiv >= 0.3 , mwc-random >= 0.13 , neat-interpolation >= 0.3.2 , network >= 2.6 @@ -732,12 +738,8 @@ executable transaction-generator -- -------------------------------------------------------------------------- -- executable ea + import: warning-flags default-language: Haskell2010 - ghc-options: - -Wall - -Wincomplete-record-updates - -Wincomplete-uni-patterns - -Wredundant-constraints hs-source-dirs: tools/ea main-is: Ea.hs build-depends: @@ -764,12 +766,8 @@ executable ea -- -------------------------------------------------------------------------- -- executable chain2gexf + import: warning-flags default-language: Haskell2010 - ghc-options: - -Wall - -Wincomplete-record-updates - -Wincomplete-uni-patterns - -Wredundant-constraints hs-source-dirs: tools/chain2gexf node main-is: Chain2Gexf.hs other-modules: @@ -791,3 +789,27 @@ executable chain2gexf , text , unordered-containers >= 0.2 , xmlgen >= 0.6 + +-- -------------------------------------------------------------------------- -- +-- run-nodes +-- -------------------------------------------------------------------------- -- + +executable run-nodes + import: warning-flags + default-language: Haskell2010 + hs-source-dirs: tools/run-nodes + main-is: RunNodes.hs + build-depends: + -- internal + chainweb + + -- external + , async >= 2.2 + , base + , base-prelude >= 1.3 + , directory >= 1.3 + , errors >= 2.3 + , formatting >= 6.3 + , optparse-applicative >= 0.14 + , shelly >= 1.8 + , text >= 1.2 diff --git a/default.nix b/default.nix index b1c81c5715..d5d34d7cfc 100644 --- a/default.nix +++ b/default.nix @@ -75,6 +75,20 @@ in sha256 = "1kvi2xqpiz7n7713m4gf702bmgbibrh4mnjdmq5s0i6nbb58zylm"; }; + # --- massiv --- # + massiv = callHackageDirect { + pkg = "massiv"; + ver = "0.3.0.0"; + sha256 = "0yv5vq9v18jzs5mbg2qpyh18dbc54s143231b3d0bw9mawp81nsi"; + }; + + scheduler = callHackageDirect { + pkg = "scheduler"; + ver = "1.0.0"; + sha256 = "0kmb7v5bl5rcn37bgz1ghrdpr22dbxkzmrd6h65jkhbvciz8hqlf"; + }; + # --- end massiv --- # + fast-builder = callHackageDirect { pkg = "fast-builder"; ver = "0.1.0.0"; diff --git a/examples/BlockHeaderChainDb.hs b/examples/BlockHeaderChainDb.hs index b9bc4a5672..26a2d4b7b4 100644 --- a/examples/BlockHeaderChainDb.hs +++ b/examples/BlockHeaderChainDb.hs @@ -46,16 +46,17 @@ import Chainweb.TreeDB import Chainweb.Utils import Chainweb.Version -import Data.DiGraph - -- -------------------------------------------------------------------------- -- -- Main -exampleChainId :: ChainId -exampleChainId = unsafeChainId 0 - graph :: ChainGraph -graph = toChainGraph (const exampleChainId) singleton +graph = singletonChainGraph + +exampleVersion :: ChainwebVersion +exampleVersion = Test graph + +exampleChainId :: ChainId +exampleChainId = someChainId exampleVersion -- | Setup a logger and run the example -- @@ -72,7 +73,7 @@ main = withHandleBackend (_logConfigBackend config) example :: Logger T.Text -> IO () example logger = do db <- DB.initBlockHeaderDb DB.Configuration - { DB._configRoot = genesisBlockHeader (Test graph) exampleChainId + { DB._configRoot = genesisBlockHeader exampleVersion exampleChainId } withAsync (observer logger db) $ \o -> do mapConcurrently_ (miner logger db) $ ChainNodeId exampleChainId <$> [0..5] diff --git a/examples/P2pExample.hs b/examples/P2pExample.hs index bec7be9f65..d757702b47 100644 --- a/examples/P2pExample.hs +++ b/examples/P2pExample.hs @@ -83,7 +83,7 @@ defaultP2pExampleConfig = P2pExampleConfig , _maxPeerCount = 50 , _sessionTimeoutSeconds = 20 , _meanSessionSeconds = 10 - , _exampleChainId = unsafeChainId 0 + , _exampleChainId = someChainId version , _logConfig = defaultLogConfig } diff --git a/node/ChainwebNode.hs b/node/ChainwebNode.hs index 49f5006d1f..8592b3586e 100644 --- a/node/ChainwebNode.hs +++ b/node/ChainwebNode.hs @@ -55,6 +55,8 @@ import GHC.Stats import qualified Network.HTTP.Client as HTTP +import Numeric.Natural + import qualified Streaming.Prelude as S import qualified System.Logger as L @@ -70,12 +72,15 @@ import Chainweb.Cut.CutHashes import Chainweb.CutDB import Chainweb.Logger import Chainweb.Payload.PayloadStore (emptyInMemoryPayloadDb) -import Chainweb.Utils.RequestLog +import Chainweb.Sync.WebBlockHeaderStore import Chainweb.Utils +import Chainweb.Utils.RequestLog import Chainweb.Version (ChainwebVersion(..)) import Data.CAS.HashMap import Data.LogMessage +import Data.PQueue +import qualified Data.TaskMap as TM import P2P.Node @@ -169,6 +174,37 @@ runRtsMonitor logger = L.withLoggerLabel ("component", "rts-monitor") logger $ \ logFunctionText l Info $ "logged stats" threadDelay 60000000 {- 1 minute -} +data QueueStats = QueueStats + { _queueStatsCutQueueSize :: !Natural + , _queueStatsBlockHeaderQueueSize :: !Natural + , _queueStatsBlockHeaderTaskMapSize :: !Natural + , _queueStatsPayloadQueueSize :: !Natural + , _queueStatsPayloadTaskMapSize :: !Natural + } + deriving (Show, Eq, Ord, Generic) + deriving anyclass (NFData, ToJSON) + +runQueueMonitor :: Logger logger => logger -> CutDb cas -> IO () +runQueueMonitor logger cutDb = L.withLoggerLabel ("component", "queue-monitor") logger $ \l -> do + go l `catchAllSynchronous` \e -> + logFunctionText l Error ("Queue Monitor failed: " <> sshow e) + logFunctionText l Info "Stopped Queue Monitor" + where + go l = do + logFunctionText l Info $ "Initialized Queue Monitor" + forever $ do + stats <- QueueStats + <$> cutDbQueueSize cutDb + <*> pQueueSize (_webBlockHeaderStoreQueue $ view cutDbWebBlockHeaderStore cutDb) + <*> (int <$> TM.size (_webBlockHeaderStoreMemo $ view cutDbWebBlockHeaderStore cutDb)) + <*> pQueueSize (_webBlockPayloadStoreQueue $ view cutDbPayloadStore cutDb) + <*> (int <$> TM.size (_webBlockPayloadStoreMemo $ view cutDbPayloadStore cutDb)) + + logFunctionText l Info $ "got stats" + logFunctionJson logger Info stats + logFunctionText l Info $ "logged stats" + threadDelay 60000000 {- 1 minute -} + -- -------------------------------------------------------------------------- -- -- Run Node @@ -178,6 +214,7 @@ node conf logger = do withChainweb @HashMapCas conf logger pdb $ \cw -> mapConcurrently_ id [ runChainweb cw , runCutMonitor (_chainwebLogger cw) (_cutResCutDb $ _chainwebCutResources cw) + , runQueueMonitor (_chainwebLogger cw) (_cutResCutDb $ _chainwebCutResources cw) , runRtsMonitor (_chainwebLogger cw) ] @@ -209,6 +246,8 @@ withNodeLogger logConfig v f = runManaged $ do $ mkTelemetryLogger @NewMinedBlock mgr teleLogConfig requestLogBackend <- managed $ mkTelemetryLogger @RequestResponseLog mgr teleLogConfig + queueStatsBackend <- managed + $ mkTelemetryLogger @QueueStats mgr teleLogConfig logger <- managed $ L.withLogger (_logConfigLogger logConfig) $ logHandles @@ -218,6 +257,7 @@ withNodeLogger logConfig v f = runManaged $ do , logHandler counterBackend , logHandler newBlockBackend , logHandler requestLogBackend + , logHandler queueStatsBackend ] baseBackend liftIO $ f @@ -245,7 +285,7 @@ mainInfo :: ProgramInfo ChainwebNodeConfiguration mainInfo = programInfo "Chainweb Node" pChainwebNodeConfiguration - (defaultChainwebNodeConfiguration Testnet00) + (defaultChainwebNodeConfiguration Testnet01) main :: IO () main = runWithPkgInfoConfiguration mainInfo pkgInfo $ \conf -> do diff --git a/pact/coin-contract/coin.pact b/pact/coin-contract/coin.pact index 04483f4009..bfe615cd40 100644 --- a/pact/coin-contract/coin.pact +++ b/pact/coin-contract/coin.pact @@ -14,13 +14,11 @@ balance:decimal guard:guard ) - (deftable coin-table:{coin-schema}) (defschema creates-schema exists:string ) - (deftable creates-table:{creates-schema}) ; -------------------------------------------------------------------------- @@ -171,14 +169,16 @@ (require-capability (TRANSFER)) (with-default-read coin-table account - { "balance" : 0.0 } - { "balance" := balance } + { "balance" : 0.0, "guard" : guard } + { "balance" := balance, "guard" := retg } + ; we don't want to overwrite an existing guard with the user-supplied one + (enforce (= retg guard) "account guards do not match") (write coin-table account { "balance" : (+ balance amount) - , "guard": guard - } - ))) + , "guard" : retg + })) + ) (defun delete-coin (delete-account create-chain-id create-account create-account-guard quantity) (with-capability (TRANSFER) diff --git a/pact/coin-contract/coin.repl b/pact/coin-contract/coin.repl index 9efc5ef708..bfafc45458 100644 --- a/pact/coin-contract/coin.repl +++ b/pact/coin-contract/coin.repl @@ -7,10 +7,11 @@ (verify 'coin) -(env-data { "k1" : ["keys1"], "k2": ["keys2"] }) -(env-keys ["keys1", "keys2"]) +(env-data { "k1" : ["keys1"], "k2": ["keys2"], "k3": ["keys3"] }) +(env-keys ["keys1", "keys2", "keys3"]) (define-keyset 'k1 (read-keyset "k1")) (define-keyset 'k2 (read-keyset "k2")) +(define-keyset 'k3 (read-keyset "k3")) (use coin) @@ -32,6 +33,10 @@ (expect "account balance reflects credit" 1.0 (account-balance 'k1)) (debit 'k1 1.0) (expect "debiting funds now succeeds when there's enough funds" 0.0 (account-balance 'k1)) +;crediting non-existing accounts with guard should have supplied keys +(credit 'k3 (read-keyset 'k3) 1.0) +(expect "crediting funds to new account succeeds with correct balance" 1.0 (account-balance 'k3)) +(expect-failure "cannot update a keyset for an existing account with wrong keyset" (credit 'k3 (read-keyset 'k2) 1.0)) ; fund-tx should require FUND_TX capability in scope, and all funds should succeed ; when available and reflect correct balances @@ -80,7 +85,7 @@ (env-keys ["keys1", "keys2", "keys3"]) (coinbase 'k3 (read-keyset 'k3) 1.0) -(expect "coinbase should create accounts and credit them some amount" 1.0 (account-balance 'k3)) +(expect "coinbase should create accounts and credit them some amount" 2.0 (account-balance 'k3)) ; SPV tests - note: proof creation will not work as we have no spv support as our default spv ; handler in the environment at this point. diff --git a/scripts/run-nodes.sh b/scripts/run-nodes.sh deleted file mode 100755 index 880b18a6f9..0000000000 --- a/scripts/run-nodes.sh +++ /dev/null @@ -1,147 +0,0 @@ -#!/bin/bash - -# ############################################################################ # -# Usage - -function usage () { - echo "USAGE:" - echo - echo " run-nodes CHAINWEB_NODE_EXE NUMBER_OF_NODES [LOG_DIRECTORY|es:ELASTICSEARCH_HOST:PORT]" - echo - echo "If third argument starts with 'es:' it is used for logging to Elasticsearch." - echo "NUMBER_OF_NODES must be between 1 and 100." - echo "Stop nodes with Ctrl-C" -} - -# ############################################################################ # -# Configuration - -function err () { - echo "Error:" 1>&2 - echo -n " " 1>&2 - echo "$@" 1>&2 - echo 1>&2 - usage 1>&2 -} - -function transaction-index-flags () { - if (( ! ${TRANSACTION_INDEX:-0} )); then - echo "disabling tx index" >/dev/stderr - echo "--disable-transaction-index" - fi -} - -LOGLEVEL=${LOGLEVEL:-info} -[ "$#" -ge 2 ] || { err "Missing arguments" ; exit -1 ; } - -# Chainweb-node application -RUN=$1 && shift - -# Number of nodes -N=$1 && shift - -LOG_DIR=$1 && shift - -# Disable Pact until pact integration passes all tests -export CHAINWEB_DISABLE_PACT=${CHAINWEB_DISABLE_PACT:-0} -[ "$CHAINWEB_DISABLE_PACT" -ne "0" ] && echo "pact is disabled" - -# ############################################################################ # -# some sanity checks - -# Check chainweb-node application -[ -x "$RUN" ] || { err "chainweb-node \"$RUN\" can't be exectuted" ; exit -1 ; } - -# check number of nodes -[ "$N" -ge 1 ] || { err "number of nodes \"$N\" to small" ; exit -1 ; } -[ "$N" -le 100 ] || { err "number of nodes \"$N\" to big" ; exit -1 ; } - -# check logdir - -ES=$([[ $LOG_DIR =~ ^es:.*:[0-9]+$ ]] && echo 1) - -[ -z "$LOG_DIR" -o -n "$ES" -o -d "$LOG_DIR" ] || { err "log directory \"$LOG_DIR\" doesn't exist" ; exit -1 ; } - -# ############################################################################ # -# Kill all nodes on exit - -function onExit () { - kill $(jobs -p) -} - -trap onExit EXIT - -# ############################################################################ # -# Run Node - -function run-node () { - local NID=$1 - local CONFIG_FILE_ARG=$2 - - if [[ -n "$LOG_DIR" ]] ; then - - # Decide handles for logs (easticsearch or file) - local APP_LOG="" - local TELEMETRY_LOG="" - if [[ -n "$ES" ]] ; then - APP_LOG="$LOG_DIR" - TELEMETRY_LOG="$LOG_DIR" - else - TELEMETRY_LOG="file:$LOG_DIR/telemetry.node$NID.log" - APP_LOG="file:$LOG_DIR/node$NID.log" - fi - - # Run with LOG_DIR - $RUN \ - --hostname=127.0.0.1 \ - --node-id=$NID \ - --test-miners=$N \ - --chainweb-version=testWithTime \ - --interface=127.0.0.1 \ - --log-level=$LOGLEVEL \ - --telemetry-log-handle="$TELEMETRY_LOG" \ - --log-handle="$APP_LOG" \ - $CONFIG_FILE_ARG \ - +RTS -T & - - else - - # Run without LOG_DIR - $RUN \ - --hostname=127.0.0.1 \ - --node-id=$NID \ - --test-miners=$N \ - --chainweb-version=testWithTime \ - --interface=127.0.0.1 \ - --log-level=$LOGLEVEL \ - $PORT_ARG \ - $CONFIG_FILE_ARG \ - +RTS -T & - fi -} - -echo "starting $N chainweb nodes" - -# Start P2P bootstrap node -# -# a bootstrap node is a node with a well defined peer-info (peer-id and -# hostaddress) that is know to all other nodes on startup. For the Test -# chainweb-node application the bootstrap node peer-info is compiled -# into the initial peer-database. - -run-node 0 "--config-file=scripts/test-bootstrap-node.config" -echo "started bootstrap node 0" - -# Start remaining nodes -# -# When no peer-id is configured a random peer-id is generated on startup. -# Omitting the port argument is the same as using --port=0, which means -# that a some free port is assigned to the node. - -for ((i=1; i Nonce -> m () encodeNonce (Nonce n) = putWord64le n +encodeNonceToWord64 :: Nonce -> Word64 +encodeNonceToWord64 (Nonce n) = BA.unLE $ BA.toLE n + decodeNonce :: MonadGet m => m Nonce decodeNonce = Nonce <$> getWord64le @@ -266,18 +275,12 @@ decodeBlockCreationTime = BlockCreationTime <$> decodeTime -- blocks without recalculating the aggregated value from the genesis block -- onward. -- +-- The POW hash is not include, since it can be derived from the Nonce and the +-- other fields of the 'BlockHeader'. +-- data BlockHeader :: Type where BlockHeader :: - { _blockParent :: {-# UNPACK #-} !BlockHash - -- ^ authoritative - - , _blockAdjacentHashes :: !BlockHashRecord - -- ^ authoritative - - , _blockTarget :: {-# UNPACK #-} !HashTarget - -- ^ authoritative - - , _blockPayloadHash :: {-# UNPACK #-} !BlockPayloadHash + { _blockNonce :: {-# UNPACK #-} !Nonce -- ^ authoritative , _blockCreationTime :: {-# UNPACK #-} !BlockCreationTime @@ -312,7 +315,16 @@ data BlockHeader :: Type where -- this strategy doesn't give an advantage to an attacker that would -- increase the success probability for an attack. - , _blockNonce :: {-# UNPACK #-} !Nonce + , _blockParent :: {-# UNPACK #-} !BlockHash + -- ^ authoritative + + , _blockAdjacentHashes :: !BlockHashRecord + -- ^ authoritative + + , _blockTarget :: {-# UNPACK #-} !HashTarget + -- ^ authoritative + + , _blockPayloadHash :: {-# UNPACK #-} !BlockPayloadHash -- ^ authoritative , _blockChainId :: {-# UNPACK #-} !ChainId @@ -386,11 +398,11 @@ instance Serialize BlockHeader where instance HasMerkleLog ChainwebHashTag BlockHeader where type MerkleLogHeader BlockHeader = - '[ BlockHash + '[ Nonce + , BlockCreationTime + , BlockHash , HashTarget , BlockPayloadHash - , BlockCreationTime - , Nonce , ChainId , BlockWeight , BlockHeight @@ -402,11 +414,12 @@ instance HasMerkleLog ChainwebHashTag BlockHeader where toLog bh = merkleLog root entries where BlockHash (MerkleLogHash root) = _blockHash bh - entries = _blockParent bh + entries + = _blockNonce bh + :+: _blockCreationTime bh + :+: _blockParent bh :+: _blockTarget bh :+: _blockPayloadHash bh - :+: _blockCreationTime bh - :+: _blockNonce bh :+: _blockChainId bh :+: _blockWeight bh :+: _blockHeight bh @@ -415,12 +428,12 @@ instance HasMerkleLog ChainwebHashTag BlockHeader where :+: MerkleLogBody (blockHashRecordToSequence $ _blockAdjacentHashes bh) fromLog l = BlockHeader - { _blockHash = BlockHash (MerkleLogHash $ _merkleLogRoot l) + { _blockNonce = nonce + , _blockCreationTime = time + , _blockHash = BlockHash (MerkleLogHash $ _merkleLogRoot l) , _blockParent = parentHash , _blockTarget = target , _blockPayloadHash = payload - , _blockCreationTime = time - , _blockNonce = nonce , _blockChainId = cid , _blockWeight = weight , _blockHeight = height @@ -429,11 +442,11 @@ instance HasMerkleLog ChainwebHashTag BlockHeader where , _blockAdjacentHashes = blockHashRecordFromSequence cwv cid adjParents } where - ( parentHash + ( nonce + :+: time + :+: parentHash :+: target :+: payload - :+: time - :+: nonce :+: cid :+: weight :+: height @@ -442,22 +455,29 @@ instance HasMerkleLog ChainwebHashTag BlockHeader where :+: MerkleLogBody adjParents ) = _merkleLogEntries l -encodeBlockHeader +encodeBlockHeaderWithoutHash :: MonadPut m => BlockHeader -> m () -encodeBlockHeader b = do +encodeBlockHeaderWithoutHash b = do + encodeNonce (_blockNonce b) + encodeBlockCreationTime (_blockCreationTime b) encodeBlockHash (_blockParent b) encodeBlockHashRecord (_blockAdjacentHashes b) encodeHashTarget (_blockTarget b) encodeBlockPayloadHash (_blockPayloadHash b) - encodeBlockCreationTime (_blockCreationTime b) - encodeNonce (_blockNonce b) encodeChainId (_blockChainId b) encodeBlockWeight (_blockWeight b) encodeBlockHeight (_blockHeight b) encodeChainwebVersion (_blockChainwebVersion b) encodeChainNodeId (_blockMiner b) + +encodeBlockHeader + :: MonadPut m + => BlockHeader + -> m () +encodeBlockHeader b = do + encodeBlockHeaderWithoutHash b encodeBlockHash (_blockHash b) -- | Decode and check that @@ -491,18 +511,50 @@ decodeBlockHeaderCheckedChainId p = do _ <- checkChainId p (Actual (_chainId bh)) return bh +-- | Decode a BlockHeader and trust the result +-- +decodeBlockHeaderWithoutHash + :: MonadGet m + => m BlockHeader +decodeBlockHeaderWithoutHash = do + a0 <- decodeNonce + a1 <- decodeBlockCreationTime + a2 <- decodeBlockHash -- parent hash + a3 <- decodeBlockHashRecord + a4 <- decodeHashTarget + a5 <- decodeBlockPayloadHash + a6 <- decodeChainId + a7 <- decodeBlockWeight + a8 <- decodeBlockHeight + a9 <- decodeChainwebVersion + a10 <- decodeChainNodeId + return + $ fromLog + $ newMerkleLog + $ a0 + :+: a1 + :+: a2 + :+: a4 + :+: a5 + :+: a6 + :+: a7 + :+: a8 + :+: a9 + :+: a10 + :+: MerkleLogBody (blockHashRecordToSequence a3) + -- | Decode a BlockHeader and trust the result -- decodeBlockHeader :: MonadGet m => m BlockHeader decodeBlockHeader = BlockHeader - <$> decodeBlockHash + <$> decodeNonce + <*> decodeBlockCreationTime + <*> decodeBlockHash -- parent hash <*> decodeBlockHashRecord <*> decodeHashTarget <*> decodeBlockPayloadHash - <*> decodeBlockCreationTime - <*> decodeNonce <*> decodeChainId <*> decodeBlockWeight <*> decodeBlockHeight @@ -546,7 +598,8 @@ isGenesisBlockHeader b = _blockHeight b == BlockHeight 0 -- the value of '_blockTarget' (interpreted as 'BlockHashNat'). -- _blockPow :: BlockHeader -> PowHash -_blockPow h = powHash (_blockChainwebVersion h) $ runPutS $ encodeBlockHeader h +_blockPow h = powHash (_blockChainwebVersion h) + $ runPutS $ encodeBlockHeaderWithoutHash h blockPow :: Getter BlockHeader PowHash blockPow = to _blockPow @@ -565,12 +618,12 @@ newtype ObjectEncoded a = ObjectEncoded { _objectEncoded :: a } instance ToJSON (ObjectEncoded BlockHeader) where toJSON (ObjectEncoded b) = object - [ "parent" .= _blockParent b + [ "nonce" .= _blockNonce b + , "creationTime" .= _blockCreationTime b + , "parent" .= _blockParent b , "adjacents" .= _blockAdjacentHashes b , "target" .= _blockTarget b , "payloadHash" .= _blockPayloadHash b - , "creationTime" .= _blockCreationTime b - , "nonce" .= _blockNonce b , "chainId" .= _chainId b , "weight" .= _blockWeight b , "height" .= _blockHeight b @@ -581,12 +634,12 @@ instance ToJSON (ObjectEncoded BlockHeader) where parseBlockHeaderObject :: Object -> Parser BlockHeader parseBlockHeaderObject o = BlockHeader - <$> o .: "parent" + <$> o .: "nonce" + <*> o .: "creationTime" + <*> o .: "parent" <*> o .: "adjacents" <*> o .: "target" <*> o .: "payloadHash" - <*> o .: "creationTime" - <*> o .: "nonce" <*> o .: "chainId" <*> o .: "weight" <*> o .: "height" @@ -604,7 +657,6 @@ newtype NewMinedBlock = NewMinedBlock (ObjectEncoded BlockHeader) deriving (Show, Generic) deriving newtype (Eq, ToJSON, NFData) - -- -------------------------------------------------------------------------- -- -- IsBlockHeader @@ -628,23 +680,9 @@ hashPayload v cid b = BlockPayloadHash $ MerkleLogHash ] -- -------------------------------------------------------------------------- -- --- TreeDBEntry instance - -instance TreeDbEntry BlockHeader where - type Key BlockHeader = BlockHash - key = _blockHash - rank = int . _blockHeight - parent e - | isGenesisBlockHeader e = Nothing - | otherwise = Just (_blockParent e) - --- -------------------------------------------------------------------------- -- --- Testing +-- Create new BlockHeader -testBlockPayload :: BlockHeader -> BlockPayloadHash -testBlockPayload b = hashPayload (_blockChainwebVersion b) b "TEST PAYLOAD" - -testBlockHeader' +newBlockHeader :: ChainNodeId -- ^ Miner -> BlockHashRecord @@ -660,12 +698,12 @@ testBlockHeader' -> BlockHeader -- ^ parent block header -> BlockHeader -testBlockHeader' miner adj pay nonce target t b = fromLog $ newMerkleLog - $ _blockHash b +newBlockHeader miner adj pay nonce target t b = fromLog $ newMerkleLog + $ nonce + :+: BlockCreationTime t + :+: _blockHash b :+: target :+: pay - :+: BlockCreationTime t - :+: nonce :+: cid :+: _blockWeight b + BlockWeight (targetToDifficulty v target) :+: _blockHeight b + 1 @@ -676,6 +714,23 @@ testBlockHeader' miner adj pay nonce target t b = fromLog $ newMerkleLog cid = _chainId b v = _blockChainwebVersion b +-- -------------------------------------------------------------------------- -- +-- TreeDBEntry instance + +instance TreeDbEntry BlockHeader where + type Key BlockHeader = BlockHash + key = _blockHash + rank = int . _blockHeight + parent e + | isGenesisBlockHeader e = Nothing + | otherwise = Just (_blockParent e) + +-- -------------------------------------------------------------------------- -- +-- Testing + +testBlockPayload :: BlockHeader -> BlockPayloadHash +testBlockPayload b = hashPayload (_blockChainwebVersion b) b "TEST PAYLOAD" + testBlockHeader :: ChainNodeId -- ^ Miner @@ -689,7 +744,7 @@ testBlockHeader -- ^ parent block header -> BlockHeader testBlockHeader miner adj nonce target b - = testBlockHeader' miner adj (testBlockPayload b) nonce target (add second t) b + = newBlockHeader miner adj (testBlockPayload b) nonce target (add second t) b where BlockCreationTime t = _blockCreationTime b diff --git a/src/Chainweb/BlockHeader/Genesis.hs b/src/Chainweb/BlockHeader/Genesis.hs index 5008cf5190..6ca66dd6eb 100644 --- a/src/Chainweb/BlockHeader/Genesis.hs +++ b/src/Chainweb/BlockHeader/Genesis.hs @@ -52,7 +52,9 @@ import Data.MerkleLog hiding (Actual, Expected, MerkleHash) import Chainweb.BlockHash import Chainweb.BlockHeader import Chainweb.BlockHeader.Genesis.Testnet00 -import Chainweb.BlockHeader.Genesis.Testnet00Payload (payloadBlock) +import qualified Chainweb.BlockHeader.Genesis.Testnet00Payload as TN0 +import Chainweb.BlockHeader.Genesis.Testnet01 +import qualified Chainweb.BlockHeader.Genesis.Testnet01Payload as TN1 import Chainweb.ChainId (ChainId, HasChainId(..), encodeChainId) import Chainweb.Crypto.MerkleLog import Chainweb.Difficulty (HashTarget, maxTarget) @@ -64,7 +66,7 @@ import Chainweb.Pact.Types (noCoinbase, noMiner, toCoinbaseOutput) import Chainweb.Payload import Chainweb.Time (Time(..), TimeSpan(..), epoche) import Chainweb.Utils -import Chainweb.Version (ChainwebVersion(..), encodeChainwebVersion) +import Chainweb.Version (ChainwebVersion(..), chainIds, encodeChainwebVersion) --- @@ -99,18 +101,19 @@ genesisTime :: ChainwebVersion -> BlockCreationTime genesisTime Test{} = BlockCreationTime epoche genesisTime TestWithTime{} = BlockCreationTime epoche genesisTime TestWithPow{} = BlockCreationTime epoche -genesisTime Simulation{} = BlockCreationTime epoche -- Tuesday, 2019 February 26, 10:55 AM genesisTime Testnet00 = BlockCreationTime . Time $ TimeSpan 1551207336601038 +-- Thursday, 2019 April 18, 11:52 AM +genesisTime Testnet01 = BlockCreationTime . Time $ TimeSpan 1555613536726767 genesisMiner :: HasChainId p => ChainwebVersion -> p -> ChainNodeId genesisMiner Test{} p = ChainNodeId (_chainId p) 0 genesisMiner TestWithTime{} p = ChainNodeId (_chainId p) 0 genesisMiner TestWithPow{} p = ChainNodeId (_chainId p) 0 -genesisMiner Simulation{} p = ChainNodeId (_chainId p) 0 -- TODO: Base the `ChainNodeId` off a Pact public key that is significant to Kadena. -- In other words, 0 is a meaningless hard-coding. genesisMiner Testnet00 p = ChainNodeId (_chainId p) 0 +genesisMiner Testnet01 p = ChainNodeId (_chainId p) 0 genesisBlockPayloadHash :: ChainwebVersion -> ChainId -> BlockPayloadHash genesisBlockPayloadHash v = _payloadWithOutputsPayloadHash . genesisBlockPayload v @@ -121,11 +124,10 @@ genesisBlockPayloadHash v = _payloadWithOutputsPayloadHash . genesisBlockPayload -- in PayloadStore. genesisBlockPayload :: ChainwebVersion -> ChainId -> PayloadWithOutputs genesisBlockPayload Test{} _ = emptyPayload -genesisBlockPayload TestWithTime{} _ = payloadBlock +genesisBlockPayload TestWithTime{} _ = TN0.payloadBlock genesisBlockPayload TestWithPow{} _ = emptyPayload -genesisBlockPayload Simulation{} _ = - error "genesisBlockPayload isn't yet defined for Simulation" -genesisBlockPayload Testnet00 _ = payloadBlock +genesisBlockPayload Testnet00 _ = TN0.payloadBlock +genesisBlockPayload Testnet01 _ = TN1.payloadBlock emptyPayload :: PayloadWithOutputs emptyPayload = PayloadWithOutputs mempty miner coinbase h i o @@ -149,6 +151,10 @@ genesisBlockHeader Testnet00 p = case HM.lookup (_chainId p) testnet00Geneses of Nothing -> error $ "Testnet00: No genesis block exists for " <> show (_chainId p) Just gb -> gb +genesisBlockHeader Testnet01 p = + case HM.lookup (_chainId p) testnet01Geneses of + Nothing -> error $ "Testnet01: No genesis block exists for " <> show (_chainId p) + Just gb -> gb genesisBlockHeader v p = genesisBlockHeader' v p (genesisTime v) (Nonce 0) @@ -168,11 +174,11 @@ genesisBlockHeader' v p ct n = fromLog mlog cid = _chainId p mlog = newMerkleLog - $ genesisParentBlockHash v cid + $ n + :+: ct + :+: genesisParentBlockHash v cid :+: genesisBlockTarget v :+: genesisBlockPayloadHash v cid - :+: ct - :+: n :+: cid :+: BlockWeight 0 :+: BlockHeight 0 @@ -188,9 +194,7 @@ genesisBlockHeaders genesisBlockHeaders v = HM.fromList . fmap (id &&& genesisBlockHeader v) . toList - . chainIds_ - . _chainGraph - $ v + $ chainIds v -- -------------------------------------------------------------------------- -- -- Testnet00 @@ -210,3 +214,29 @@ testnet00Geneses = HM.fromList $ map (_chainId &&& id) bs , testnet00C8 , testnet00C9 ] {-# NOINLINE testnet00Geneses #-} + +-- | Twenty Genesis Blocks for `Testnet00`. +testnet01Geneses :: HM.HashMap ChainId BlockHeader +testnet01Geneses = HM.fromList $ map (_chainId &&& id) bs + where + bs = [ testnet01C0 + , testnet01C1 + , testnet01C2 + , testnet01C3 + , testnet01C4 + , testnet01C5 + , testnet01C6 + , testnet01C7 + , testnet01C8 + , testnet01C9 + , testnet01C10 + , testnet01C11 + , testnet01C12 + , testnet01C13 + , testnet01C14 + , testnet01C15 + , testnet01C16 + , testnet01C17 + , testnet01C18 + , testnet01C19 ] +{-# NOINLINE testnet01Geneses #-} diff --git a/src/Chainweb/BlockHeader/Genesis/Testnet00.hs b/src/Chainweb/BlockHeader/Genesis/Testnet00.hs index 4c799ae91d..88b3a88a9b 100644 --- a/src/Chainweb/BlockHeader/Genesis/Testnet00.hs +++ b/src/Chainweb/BlockHeader/Genesis/Testnet00.hs @@ -24,7 +24,7 @@ testnet00C0 = unsafeFromYamlText creationTime: 1551207336601038 parent: hkY3tAJOaRSSTG5DUYBEMRjNlZr2jEyA_8d0_NJ76ow height: 0 -hash: 86-gNRmyen20Pc3Hc2IFyo5tOW4mWvzAMQzcuH-k750 +hash: oiHccv7-mi8Q9txEHcwWDWrZIb8gP-2i5gg1jjtPsVg miner: 0/0 chainId: 0 weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA @@ -32,10 +32,10 @@ adjacents: '2': zBD6jyT5Irr5QIcNoDw48_aN8TcPI7-HgHJBYm_ra18 '5': jRBryPOLRqBKjceQXsRuLp6Q9mMqrZmCW3vQ3XgDtts '3': iliOelarez9K7DNE1Je8V_TczJAgJh4dB9Pm3WgKbMQ -payloadHash: sETlp5mHHrLenYrLZhGZ4_dq9FiH608uBuq9fEQrp6k +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw chainwebVersion: testnet00 target: ________________________________________AwA -nonce: '23401' +nonce: '10210' |] @@ -45,7 +45,7 @@ testnet00C1 = unsafeFromYamlText creationTime: 1551207336601038 parent: gSDXx0M9qJg03BU2zi1jDGo0n8lHhcojup27cl5bVtM height: 0 -hash: R2YxoXFnW0JPqZl6GZV8d8xjFp6fCU3Ayx7MhrtSGbs +hash: lhUB0paJzaIlVkJHqRVZx3g7LOYY6m_r0J6MVnP3jKk miner: 0/1 chainId: 1 weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA @@ -53,10 +53,10 @@ adjacents: '4': E8g1sAZD7xvIRLiqF-TmQ6YwIh1lUxmIpSzaJb9F8WM '3': iliOelarez9K7DNE1Je8V_TczJAgJh4dB9Pm3WgKbMQ '6': xSXQP0riuw-DDRLz-BEdw7Vn7C8c8ICwlQK_DwhE18Q -payloadHash: sETlp5mHHrLenYrLZhGZ4_dq9FiH608uBuq9fEQrp6k +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw chainwebVersion: testnet00 target: ________________________________________AwA -nonce: '4605' +nonce: '4939' |] @@ -66,7 +66,7 @@ testnet00C2 = unsafeFromYamlText creationTime: 1551207336601038 parent: zBD6jyT5Irr5QIcNoDw48_aN8TcPI7-HgHJBYm_ra18 height: 0 -hash: 0KU7BNWMNOI25nJ6PrDqEAmKfxHKPtRSi6FbYZ2Ygu8 +hash: AhM01jUrM7Thy1bPWAxfrJah0y0D6IkMXEHwDYpQ1o8 miner: 0/2 chainId: 2 weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA @@ -74,10 +74,10 @@ adjacents: '7': wHYmEOiBrC3l7ZaZdrr2Nr1ClvsA6WdS3Tps20HfvjY '0': hkY3tAJOaRSSTG5DUYBEMRjNlZr2jEyA_8d0_NJ76ow '4': E8g1sAZD7xvIRLiqF-TmQ6YwIh1lUxmIpSzaJb9F8WM -payloadHash: sETlp5mHHrLenYrLZhGZ4_dq9FiH608uBuq9fEQrp6k +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw chainwebVersion: testnet00 target: ________________________________________AwA -nonce: '13593' +nonce: '50280' |] @@ -87,7 +87,7 @@ testnet00C3 = unsafeFromYamlText creationTime: 1551207336601038 parent: iliOelarez9K7DNE1Je8V_TczJAgJh4dB9Pm3WgKbMQ height: 0 -hash: kpgBxNwBsBHPEKKHNUJR90uRT5zbW5SrYXKW8381Qg8 +hash: zHzI-wDBFIvWnyIhDkTpgCNhO02OutB3tEifm4-AKqA miner: 0/3 chainId: 3 weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA @@ -95,10 +95,10 @@ adjacents: '0': hkY3tAJOaRSSTG5DUYBEMRjNlZr2jEyA_8d0_NJ76ow '1': gSDXx0M9qJg03BU2zi1jDGo0n8lHhcojup27cl5bVtM '8': -acx5PNzURsOtqhJKm08Zf9FchU7FDs64cKVqA5Vm0A -payloadHash: sETlp5mHHrLenYrLZhGZ4_dq9FiH608uBuq9fEQrp6k +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw chainwebVersion: testnet00 target: ________________________________________AwA -nonce: '32593' +nonce: '3039' |] @@ -108,7 +108,7 @@ testnet00C4 = unsafeFromYamlText creationTime: 1551207336601038 parent: E8g1sAZD7xvIRLiqF-TmQ6YwIh1lUxmIpSzaJb9F8WM height: 0 -hash: i8H0pGxbLsxpeATXdXS5Yb_dcMCZpmiLs5ao0quHdPo +hash: Ww7lmBkesV71LoM9ZupsqTlyahBvw_7WpmK1WKe7Iv4 miner: 0/4 chainId: 4 weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA @@ -116,10 +116,10 @@ adjacents: '1': gSDXx0M9qJg03BU2zi1jDGo0n8lHhcojup27cl5bVtM '2': zBD6jyT5Irr5QIcNoDw48_aN8TcPI7-HgHJBYm_ra18 '9': CY9Uo83VT4g_RJar_lLItK_MpWvl4e4yHsY1i2KXuBk -payloadHash: sETlp5mHHrLenYrLZhGZ4_dq9FiH608uBuq9fEQrp6k +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw chainwebVersion: testnet00 target: ________________________________________AwA -nonce: '12533' +nonce: '7418' |] @@ -129,7 +129,7 @@ testnet00C5 = unsafeFromYamlText creationTime: 1551207336601038 parent: jRBryPOLRqBKjceQXsRuLp6Q9mMqrZmCW3vQ3XgDtts height: 0 -hash: P0iuUahzFtXPNiqqxkzF6KxeOGSlibFpihYhRofnjFo +hash: c8si5vThnqWIP9wjobTJJTD3JK-sVrCaz8IhPLoMTGI miner: 0/5 chainId: 5 weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA @@ -137,10 +137,10 @@ adjacents: '0': hkY3tAJOaRSSTG5DUYBEMRjNlZr2jEyA_8d0_NJ76ow '6': xSXQP0riuw-DDRLz-BEdw7Vn7C8c8ICwlQK_DwhE18Q '9': CY9Uo83VT4g_RJar_lLItK_MpWvl4e4yHsY1i2KXuBk -payloadHash: sETlp5mHHrLenYrLZhGZ4_dq9FiH608uBuq9fEQrp6k +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw chainwebVersion: testnet00 target: ________________________________________AwA -nonce: '31308' +nonce: '53106' |] @@ -150,7 +150,7 @@ testnet00C6 = unsafeFromYamlText creationTime: 1551207336601038 parent: xSXQP0riuw-DDRLz-BEdw7Vn7C8c8ICwlQK_DwhE18Q height: 0 -hash: y6aIqPnlM4ljcet5wafzuESXqJVK8E3S13g5Bl95DR0 +hash: w7ipNZkv7bWmRloz3-kJ8YIMHVxQYcCgh-NsdcJNdgc miner: 0/6 chainId: 6 weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA @@ -158,10 +158,10 @@ adjacents: '7': wHYmEOiBrC3l7ZaZdrr2Nr1ClvsA6WdS3Tps20HfvjY '1': gSDXx0M9qJg03BU2zi1jDGo0n8lHhcojup27cl5bVtM '5': jRBryPOLRqBKjceQXsRuLp6Q9mMqrZmCW3vQ3XgDtts -payloadHash: sETlp5mHHrLenYrLZhGZ4_dq9FiH608uBuq9fEQrp6k +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw chainwebVersion: testnet00 target: ________________________________________AwA -nonce: '21354' +nonce: '19521' |] @@ -171,7 +171,7 @@ testnet00C7 = unsafeFromYamlText creationTime: 1551207336601038 parent: wHYmEOiBrC3l7ZaZdrr2Nr1ClvsA6WdS3Tps20HfvjY height: 0 -hash: r9v1Yg-bwC2mpUMWMNrpJbWXqBHLRayq_RnQiPxeYU8 +hash: AnOg2nn5ODQPWXpkMHZ1qANxfld-4ZN8YNJ0WRhaeqc miner: 0/7 chainId: 7 weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA @@ -179,10 +179,10 @@ adjacents: '2': zBD6jyT5Irr5QIcNoDw48_aN8TcPI7-HgHJBYm_ra18 '8': -acx5PNzURsOtqhJKm08Zf9FchU7FDs64cKVqA5Vm0A '6': xSXQP0riuw-DDRLz-BEdw7Vn7C8c8ICwlQK_DwhE18Q -payloadHash: sETlp5mHHrLenYrLZhGZ4_dq9FiH608uBuq9fEQrp6k +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw chainwebVersion: testnet00 target: ________________________________________AwA -nonce: '9727' +nonce: '11326' |] @@ -192,7 +192,7 @@ testnet00C8 = unsafeFromYamlText creationTime: 1551207336601038 parent: -acx5PNzURsOtqhJKm08Zf9FchU7FDs64cKVqA5Vm0A height: 0 -hash: vgeqnMZwhDTwloeOENcCXGBB5GqZ772EzLr_JBjwTfk +hash: wYVtb3B9jphLNg-3nQTalJbI63mTXzAiQPtIJ9zzic4 miner: 0/8 chainId: 8 weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA @@ -200,10 +200,10 @@ adjacents: '7': wHYmEOiBrC3l7ZaZdrr2Nr1ClvsA6WdS3Tps20HfvjY '3': iliOelarez9K7DNE1Je8V_TczJAgJh4dB9Pm3WgKbMQ '9': CY9Uo83VT4g_RJar_lLItK_MpWvl4e4yHsY1i2KXuBk -payloadHash: sETlp5mHHrLenYrLZhGZ4_dq9FiH608uBuq9fEQrp6k +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw chainwebVersion: testnet00 target: ________________________________________AwA -nonce: '12875' +nonce: '959' |] @@ -213,7 +213,7 @@ testnet00C9 = unsafeFromYamlText creationTime: 1551207336601038 parent: CY9Uo83VT4g_RJar_lLItK_MpWvl4e4yHsY1i2KXuBk height: 0 -hash: vMv3IS037sPYNKvQwE_3NcajxCIUlHaI-YLwE8B4LWw +hash: VAAa42pPLHtlB_XcydDEkEZNcwPjamKEGvPmVDEsfRI miner: 0/9 chainId: 9 weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA @@ -221,10 +221,10 @@ adjacents: '4': E8g1sAZD7xvIRLiqF-TmQ6YwIh1lUxmIpSzaJb9F8WM '5': jRBryPOLRqBKjceQXsRuLp6Q9mMqrZmCW3vQ3XgDtts '8': -acx5PNzURsOtqhJKm08Zf9FchU7FDs64cKVqA5Vm0A -payloadHash: sETlp5mHHrLenYrLZhGZ4_dq9FiH608uBuq9fEQrp6k +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw chainwebVersion: testnet00 target: ________________________________________AwA -nonce: '14423' +nonce: '47678' |] diff --git a/src/Chainweb/BlockHeader/Genesis/Testnet00Payload.hs b/src/Chainweb/BlockHeader/Genesis/Testnet00Payload.hs index 3e5e010524..eadc2c6628 100644 --- a/src/Chainweb/BlockHeader/Genesis/Testnet00Payload.hs +++ b/src/Chainweb/BlockHeader/Genesis/Testnet00Payload.hs @@ -15,14 +15,14 @@ import Chainweb.Utils (fromJuste) payloadBlock :: PayloadWithOutputs payloadBlock = fromJuste $ decodeThrow $ encodeUtf8 [text| transactions: -- - eyJoYXNoIjoiYTgyZTQ1NGQ2ZTRiMjA5NzcxYjBhMjJjN2MxN2Q2MDhkYjE1NTNkYjYyMDEzMWEwMjBhYTI4NjMzZGFjMzIxZjcyMWNhZTRjZjQ0ZGI3ZDNiNzcxODRlOGM4ZTUyNzk3ZWIzNjA4MzYwY2I5ZDUyMjQ4OWJkMDc4NDdlNTFhNjUiLCJzaWdzIjpbXSwiY21kIjoie1wicGF5bG9hZFwiOntcImV4ZWNcIjp7XCJkYXRhXCI6bnVsbCxcImNvZGVcIjpcIihtb2R1bGUgY29pbiBHT1ZFUk5BTkNFXFxuXFxuICBcXFwiJ2NvaW4nIHJlcHJlc2VudHMgdGhlIEthZGVuYSBDb2luIENvbnRyYWN0LlxcXCJcXG5cXG5cXG4gIDsgKGltcGxlbWVudHMgY29pbi1jb250cmFjdC1zaWcpXFxuXFxuICA7IC0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tXFxuICA7IFNjaGVtYXMgYW5kIFRhYmxlc1xcbiAgOyAtLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLVxcblxcbiAgKGRlZnNjaGVtYSBjb2luLXNjaGVtYVxcbiAgICBiYWxhbmNlOmRlY2ltYWxcXG4gICAgZ3VhcmQ6Z3VhcmRcXG4gICAgKVxcblxcbiAgKGRlZnRhYmxlIGNvaW4tdGFibGU6e2NvaW4tc2NoZW1hfSlcXG5cXG4gIDsgLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS1cXG4gIDsgQ2FwYWJpbGl0aWVzXFxuICA7IC0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tXFxuXFxuICAoZGVmY2FwIEdPVkVSTkFOQ0UgKCkgKGVuZm9yY2UgZmFsc2UgXFxcInVwZ3JhZGUgZGlzYWJsZWRcXFwiKSlcXG5cXG4gIChkZWZjYXAgVFJBTlNGRVIgKClcXG4gICAgXFxcIkF1dG9ub21vdXMgY2FwYWJpbGl0eSB0byBwcm90ZWN0IGRlYml0IGFuZCBjcmVkaXQgYWN0aW9uc1xcXCJcXG4gICAgdHJ1ZSlcXG5cXG4gIChkZWZjYXAgQ09JTkJBU0UgKClcXG4gICAgXFxcIk1hZ2ljIGNhcGFiaWxpdHkgdG8gcHJvdGVjdCBtaW5lciByZXdhcmRcXFwiXFxuICAgIHRydWUpXFxuXFxuICAoZGVmY2FwIEZVTkRfVFggKClcXG4gICAgXFxcIk1hZ2ljIGNhcGFiaWxpdHkgdG8gZXhlY3V0ZSBnYXMgcHVyY2hhc2VzIGFuZCByZWRlbXB0aW9uc1xcXCJcXG4gICAgdHJ1ZSlcXG5cXG4gIChkZWZjYXAgQUNDT1VOVF9HVUFSRCAoYWNjb3VudClcXG4gICAgXFxcIkxvb2t1cCBhbmQgZW5mb3JjZSBndWFyZHMgYXNzb2NpYXRlZCB3aXRoIGFuIGFjY291bnRcXFwiXFxuICAgICh3aXRoLXJlYWQgY29pbi10YWJsZSBhY2NvdW50IHsgXFxcImd1YXJkXFxcIiA6PSBnIH1cXG4gICAgICAoZW5mb3JjZS1ndWFyZCBnKSkpXFxuXFxuICAoZGVmY2FwIEdPVkVSTkFOQ0UgKClcXG4gICAgKGVuZm9yY2UgZmFsc2UgXFxcIkVuZm9yY2Ugbm9uLXVwZ3JhZGVhYmlsaXR5IGV4Y2VwdCBpbiB0aGUgY2FzZSBvZiBhIGhhcmQgZm9ya1xcXCIpKVxcblxcbiAgOyAtLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLVxcbiAgOyBDb2luIENvbnRyYWN0XFxuICA7IC0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tXFxuXFxuICAoZGVmdW4gYnV5LWdhczpzdHJpbmcgKHNlbmRlcjpzdHJpbmcgdG90YWw6ZGVjaW1hbClcXG4gICAgQGRvYyBcXFwiVGhpcyBmdW5jdGlvbiBkZXNjcmliZXMgdGhlIG1haW4gJ2dhcyBidXknIG9wZXJhdGlvbi4gQXQgdGhpcyBwb2ludCBcXFxcXFxuICAgIFxcXFxNSU5FUiBoYXMgYmVlbiBjaG9zZW4gZnJvbSB0aGUgcG9vbCwgYW5kIHdpbGwgYmUgdmFsaWRhdGVkLiBUaGUgU0VOREVSICAgXFxcXFxcbiAgICBcXFxcb2YgdGhpcyB0cmFuc2FjdGlvbiBoYXMgc3BlY2lmaWVkIGEgZ2FzIGxpbWl0IExJTUlUIChtYXhpbXVtIGdhcykgZm9yICAgIFxcXFxcXG4gICAgXFxcXHRoZSB0cmFuc2FjdGlvbiwgYW5kIHRoZSBwcmljZSBpcyB0aGUgc3BvdCBwcmljZSBvZiBnYXMgYXQgdGhhdCB0aW1lLiAgICBcXFxcXFxuICAgIFxcXFxUaGUgZ2FzIGJ1eSB3aWxsIGJlIGV4ZWN1dGVkIHByaW9yIHRvIGV4ZWN1dGluZyBTRU5ERVIncyBjb2RlLlxcXCJcXG5cXG4gICAgQG1vZGVsIFsocHJvcGVydHkgKD4gdG90YWwgMC4wKSldXFxuXFxuICAgIChyZXF1aXJlLWNhcGFiaWxpdHkgKEZVTkRfVFgpKVxcbiAgICAod2l0aC1jYXBhYmlsaXR5IChUUkFOU0ZFUilcXG4gICAgICAgKGRlYml0IHNlbmRlciB0b3RhbCkpXFxuICAgIClcXG5cXG4gIChkZWZ1biByZWRlZW0tZ2FzOnN0cmluZyAobWluZXI6c3RyaW5nIG1pbmVyLWd1YXJkOmd1YXJkIHNlbmRlcjpzdHJpbmcgdG90YWw6ZGVjaW1hbClcXG4gICAgQGRvYyBcXFwiVGhpcyBmdW5jdGlvbiBkZXNjcmliZXMgdGhlIG1haW4gJ3JlZGVlbSBnYXMnIG9wZXJhdGlvbi4gQXQgdGhpcyAgICBcXFxcXFxuICAgIFxcXFxwb2ludCwgdGhlIFNFTkRFUidzIHRyYW5zYWN0aW9uIGhhcyBiZWVuIGV4ZWN1dGVkLCBhbmQgdGhlIGdhcyB0aGF0ICAgICAgXFxcXFxcbiAgICBcXFxcd2FzIGNoYXJnZWQgaGFzIGJlZW4gY2FsY3VsYXRlZC4gTUlORVIgd2lsbCBiZSBjcmVkaXRlZCB0aGUgZ2FzIGNvc3QsICAgIFxcXFxcXG4gICAgXFxcXGFuZCBTRU5ERVIgd2lsbCByZWNlaXZlIHRoZSByZW1haW5kZXIgdXAgdG8gdGhlIGxpbWl0XFxcIlxcblxcbiAgICBAbW9kZWwgWyhwcm9wZXJ0eSAoPiB0b3RhbCAwLjApKV1cXG5cXG4gICAgKHJlcXVpcmUtY2FwYWJpbGl0eSAoRlVORF9UWCkpXFxuICAgICh3aXRoLWNhcGFiaWxpdHkgKFRSQU5TRkVSKVxcbiAgICAgIChsZXQqICgoZmVlIChyZWFkLWRlY2ltYWwgXFxcImZlZVxcXCIpKVxcbiAgICAgICAgICAgICAocmVmdW5kICgtIHRvdGFsIGZlZSkpKVxcbiAgICAgICAgKGVuZm9yY2UgKD49IHJlZnVuZCAwLjApIFxcXCJmZWUgbXVzdCBiZSBsZXNzIHRoYW4gb3IgZXF1YWwgdG8gdG90YWxcXFwiKVxcblxcblxcbiAgICAgICAgOyBkaXJlY3RseSB1cGRhdGUgaW5zdGVhZCBvZiBjcmVkaXRcXG4gICAgICAgIChpZiAoPiByZWZ1bmQgMC4wKVxcbiAgICAgICAgICAod2l0aC1yZWFkIGNvaW4tdGFibGUgc2VuZGVyXFxuICAgICAgICAgICAgeyBcXFwiYmFsYW5jZVxcXCIgOj0gYmFsYW5jZSB9XFxuICAgICAgICAgICAgKHVwZGF0ZSBjb2luLXRhYmxlIHNlbmRlclxcbiAgICAgICAgICAgICAgeyBcXFwiYmFsYW5jZVxcXCI6ICgrIGJhbGFuY2UgcmVmdW5kKSB9KVxcbiAgICAgICAgICAgIClcXG4gICAgICAgICAgXFxcIm5vb3BcXFwiKVxcbiAgICAgICAgKGNyZWRpdCBtaW5lciBtaW5lci1ndWFyZCBmZWUpXFxuICAgICAgICApKVxcbiAgICApXFxuXFxuICAoZGVmdW4gY3JlYXRlLWFjY291bnQ6c3RyaW5nIChhY2NvdW50OnN0cmluZyBndWFyZDpndWFyZClcXG4gICAgQGRvYyBcXFwiQ3JlYXRlIGFuIGFjY291bnQgZm9yIEFDQ09VTlQsIHdpdGggQUNDT1VOVCBhcyBhIGZ1bmN0aW9uIG9mIEdVQVJEXFxcIlxcbiAgICAoaW5zZXJ0IGNvaW4tdGFibGUgYWNjb3VudFxcbiAgICAgIHsgXFxcImJhbGFuY2VcXFwiIDogMC4wXFxuICAgICAgLCBcXFwiZ3VhcmRcXFwiICAgOiBndWFyZFxcbiAgICAgIH0pXFxuICAgIClcXG5cXG4gIChkZWZ1biBhY2NvdW50LWJhbGFuY2U6ZGVjaW1hbCAoYWNjb3VudDpzdHJpbmcpXFxuICAgIEBkb2MgXFxcIlF1ZXJ5IGFjY291bnQgYmFsYW5jZSBmb3IgQUNDT1VOVFxcXCJcXG4gICAgKHdpdGgtY2FwYWJpbGl0eSAoQUNDT1VOVF9HVUFSRCBhY2NvdW50KVxcbiAgICAgICh3aXRoLXJlYWQgY29pbi10YWJsZSBhY2NvdW50XFxuICAgICAgICB7IFxcXCJiYWxhbmNlXFxcIiA6PSBiYWxhbmNlIH1cXG4gICAgICAgIGJhbGFuY2VcXG4gICAgICAgICkpXFxuICAgIClcXG5cXG4gIChkZWZ1biB0cmFuc2ZlcjpzdHJpbmcgKHNlbmRlcjpzdHJpbmcgcmVjZWl2ZXI6c3RyaW5nIHJlY2VpdmVyLWd1YXJkOmd1YXJkIGFtb3VudDpkZWNpbWFsKVxcbiAgICBAZG9jIFxcXCJUcmFuc2ZlciBiZXR3ZWVuIGFjY291bnRzIFNFTkRFUiBhbmQgUkVDRUlWRVIgb24gdGhlIHNhbWUgY2hhaW4uICAgIFxcXFxcXG4gICAgXFxcXFRoaXMgZmFpbHMgaWYgYm90aCBhY2NvdW50cyBkbyBub3QgZXhpc3QuIENyZWF0ZS1vbi10cmFuc2ZlciBjYW4gYmUgICAgICBcXFxcXFxuICAgIFxcXFxoYW5kbGVkIGJ5IHNlbmRpbmcgaW4gYSBjcmVhdGUgY29tbWFuZCBpbiB0aGUgc2FtZSB0eC5cXFwiXFxuXFxuICAgIEBtb2RlbCBbKHByb3BlcnR5ICg-IGFtb3VudCAwLjApKV1cXG5cXG4gICAgKHdpdGgtY2FwYWJpbGl0eSAoVFJBTlNGRVIpXFxuICAgICAgKGRlYml0IHNlbmRlciBhbW91bnQpXFxuICAgICAgKGNyZWRpdCByZWNlaXZlciByZWNlaXZlci1ndWFyZCBhbW91bnQpKVxcbiAgICApXFxuXFxuICAoZGVmdW4gY29pbmJhc2U6c3RyaW5nIChhZGRyZXNzOnN0cmluZyBhZGRyZXNzLWd1YXJkOmd1YXJkIGFtb3VudDpkZWNpbWFsKVxcbiAgICBAZG9jIFxcXCJNaW50IHNvbWUgbnVtYmVyIG9mIHRva2VucyBhbmQgYWxsb2NhdGUgdGhlbSB0byBzb21lIGFkZHJlc3NcXFwiXFxuICAgIChyZXF1aXJlLWNhcGFiaWxpdHkgKENPSU5CQVNFKSlcXG4gICAgKHdpdGgtY2FwYWJpbGl0eSAoVFJBTlNGRVIpXFxuICAgICAoY3JlZGl0IGFkZHJlc3MgYWRkcmVzcy1ndWFyZCBhbW91bnQpKSlcXG5cXG4gIChkZWZwYWN0IGZ1bmQtdHggKHNlbmRlciBtaW5lciBtaW5lci1ndWFyZCB0b3RhbClcXG4gICAgQGRvYyBcXFwiJ2Z1bmQtdHgnIGlzIGEgc3BlY2lhbCBwYWN0IHRvIGZ1bmQgYSB0cmFuc2FjdGlvbiBpbiB0d28gc3RlcHMsICAgICBcXFxcXFxuICAgIFxcXFx3aXRoIHRoZSBhY3R1YWwgdHJhbnNhY3Rpb24gdHJhbnNwaXJpbmcgaW4gdGhlIG1pZGRsZTogICAgICAgICAgICAgICAgICAgXFxcXFxcbiAgICBcXFxcICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIFxcXFxcXG4gICAgXFxcXCAgMSkgQSBidXlpbmcgcGhhc2UsIGRlYml0aW5nIHRoZSBzZW5kZXIgZm9yIHRvdGFsIGdhcyBhbmQgZmVlLCB5aWVsZGluZyBcXFxcXFxuICAgIFxcXFwgICAgIFRYX01BWF9DSEFSR0UuICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgXFxcXFxcbiAgICBcXFxcICAyKSBBIHNldHRsZW1lbnQgcGhhc2UsIHJlc3VtaW5nIFRYX01BWF9DSEFSR0UsIGFuZCBhbGxvY2F0aW5nIHRvIHRoZSAgIFxcXFxcXG4gICAgXFxcXCAgICAgY29pbmJhc2UgYWNjb3VudCBmb3IgdXNlZCBnYXMgYW5kIGZlZSwgYW5kIHNlbmRlciBhY2NvdW50IGZvciBiYWwtICBcXFxcXFxuICAgIFxcXFwgICAgIGFuY2UgKHVudXNlZCBnYXMsIGlmIGFueSkuXFxcIlxcblxcbiAgICAoc3RlcCAoYnV5LWdhcyBzZW5kZXIgdG90YWwpKVxcbiAgICAoc3RlcCAocmVkZWVtLWdhcyBtaW5lciBtaW5lci1ndWFyZCBzZW5kZXIgdG90YWwpKVxcbiAgICApXFxuXFxuICA7IC0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tXFxuICA7IEhlbHBlcnNcXG4gIDsgLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS1cXG5cXG4gIChkZWZ1biBkZWJpdDpzdHJpbmcgKGFjY291bnQ6c3RyaW5nIGFtb3VudDpkZWNpbWFsKVxcbiAgICBAZG9jIFxcXCJEZWJpdCBBTU9VTlQgZnJvbSBBQ0NPVU5UIGJhbGFuY2UgcmVjb3JkaW5nIERBVEUgYW5kIERBVEFcXFwiXFxuXFxuICAgIEBtb2RlbCBbKHByb3BlcnR5ICg-IGFtb3VudCAwLjApKV1cXG5cXG4gICAgKHJlcXVpcmUtY2FwYWJpbGl0eSAoVFJBTlNGRVIpKVxcbiAgICAod2l0aC1jYXBhYmlsaXR5IChBQ0NPVU5UX0dVQVJEIGFjY291bnQpXFxuICAgICAgKHdpdGgtcmVhZCBjb2luLXRhYmxlIGFjY291bnRcXG4gICAgICAgIHsgXFxcImJhbGFuY2VcXFwiIDo9IGJhbGFuY2UgfVxcblxcbiAgICAgICAgKGVuZm9yY2UgKDw9IGFtb3VudCBiYWxhbmNlKSBcXFwiSW5zdWZmaWNpZW50IGZ1bmRzXFxcIilcXG4gICAgICAgICh1cGRhdGUgY29pbi10YWJsZSBhY2NvdW50XFxuICAgICAgICAgIHsgXFxcImJhbGFuY2VcXFwiIDogKC0gYmFsYW5jZSBhbW91bnQpIH1cXG4gICAgICAgICAgKSkpXFxuICAgIClcXG5cXG5cXG4gIChkZWZ1biBjcmVkaXQ6c3RyaW5nIChhY2NvdW50OnN0cmluZyBndWFyZDpndWFyZCBhbW91bnQ6ZGVjaW1hbClcXG4gICAgQGRvYyBcXFwiQ3JlZGl0IEFNT1VOVCB0byBBQ0NPVU5UIGJhbGFuY2UgcmVjb3JkaW5nIERBVEUgYW5kIERBVEFcXFwiXFxuXFxuICAgIEBtb2RlbCBbKHByb3BlcnR5ICg-IGFtb3VudCAwLjApKV1cXG5cXG4gICAgKHJlcXVpcmUtY2FwYWJpbGl0eSAoVFJBTlNGRVIpKVxcbiAgICAgICh3aXRoLWRlZmF1bHQtcmVhZCBjb2luLXRhYmxlIGFjY291bnRcXG4gICAgICAgIHsgXFxcImJhbGFuY2VcXFwiIDogMC4wIH1cXG4gICAgICAgIHsgXFxcImJhbGFuY2VcXFwiIDo9IGJhbGFuY2UgfVxcblxcbiAgICAgICAgKHdyaXRlIGNvaW4tdGFibGUgYWNjb3VudFxcbiAgICAgICAgICB7IFxcXCJiYWxhbmNlXFxcIiA6ICgrIGJhbGFuY2UgYW1vdW50KVxcbiAgICAgICAgICAsIFxcXCJndWFyZFxcXCI6IGd1YXJkXFxuICAgICAgICAgIH1cXG4gICAgICAgICAgKSkpXFxuKVxcblxcbihjcmVhdGUtdGFibGUgY29pbi10YWJsZSlcXG5cIn19LFwibWV0YVwiOntcImdhc0xpbWl0XCI6MCxcImNoYWluSWRcIjpcIlwiLFwiZ2FzUHJpY2VcIjowLFwic2VuZGVyXCI6XCJcIixcImZlZVwiOjB9LFwibm9uY2VcIjpcIlxcXCJnZW5lc2lzLTAxXFxcIlwifSJ9 - - eyJobFR4TG9ncyI6IjJjYzdiNmJlMmFjYjc1MjZhYmU4YTg2ODk3NDY4N2IwYzg3NjkyZTFlMDY3NWFiNGQ2ZjFiMzMwMzBiYTdiZGI2ODI3NGIxYWFlMDBlNTI4YmI4NmQxNDM5Nzg2MGJjNjBhZTQwYmQzMjVmMWY0MzFhNGZiYjEzODczNDI3Njg2IiwiaGxDb21tYW5kUmVzdWx0Ijp7InN0YXR1cyI6InN1Y2Nlc3MiLCJkYXRhIjoiVGFibGVDcmVhdGVkIn19 -- - eyJoYXNoIjoiZjQyNTlhNDhmODE5NTZmNzFmOGRhMzczODUwYjNlYmZlYzNiNjUwNTQ5Y2RiNGE4ZTNjNWZmYmYyMzQzMjM3ZDQzMTVmNTE4ODcxMzQwNTc3YWE1YzI2ZjgyNTYyZWUzMDQ5NGZhOTdiNTlmNTIxNjA2YzI4ODdjN2UyYzliOWIiLCJzaWdzIjpbXSwiY21kIjoie1wicGF5bG9hZFwiOntcImV4ZWNcIjp7XCJkYXRhXCI6e1wic2VuZGVyMDdcIjpbXCI0YzMxZGM5ZWU3ZjI0MTc3Zjc4YjZmNTE4MDEyYTIwODMyNmUyYWYxZjM3YmIwYTI0MDViNTA1NmQwY2FkNjI4XCJdLFwic2VuZGVyMDFcIjpbXCI2YmUyZjQ4NWE3YWY3NWZlZGI0YjdmMTUzYTkwM2Y3ZTYwMDBjYTRhYTUwMTE3OWM5MWEyNDUwYjc3N2JkMmE3XCJdLFwic2VuZGVyMDZcIjpbXCI1ZmZjMWY3ZmVmN2E0NDczODYyNTc2MmY3NWE0MjI5NDU0OTUxZTAzZjJhZmM2ZjgxMzA5YzBjMWJkZjllZTZmXCJdLFwic2VuZGVyMDBcIjpbXCIzNjg4MjBmODBjMzI0YmJjN2MyYjA2MTA2ODhhN2RhNDNlMzlmOTFkMTE4NzMyNjcxY2Q5Yzc1MDBmZjQzY2NhXCJdLFwic2VuZGVyMDVcIjpbXCJmMDlkOGY2Mzk0YWVhNDI1ZmU2NzgzZDg4Y2Q4MTM2M2Q4MDE3ZjE2YWZkMzcxMWM1NzViZTBmNWNkNWM5YmI5XCJdLFwic2VuZGVyMDRcIjpbXCIyZDcwYWE0ZjY5N2MzYTNiOGRkNmQ5Nzc0NWFjMDc0ZWRjZmQwZWI2NWMzNzc3NGNkZTI1MTM1NDgzYmVhNzFlXCJdLFwibXVsdGktMDItMDMtMDQtYW55XCI6e1wicHJlZFwiOlwia2V5cy1hbnlcIixcImtleXNcIjpbXCIzYTlkZDUzMmQ3M2RhY2UxOTVkYmI2NGQxZGJhNjU3MmZiNzgzZDBmZGQzMjQ2ODVlMzJmYmRhMmY4OWY5OWE2XCIsXCI0M2YyYWRiMWRlMTkyMDAwY2IzNzc3YmFjYzdmOTgzYjY2MTRmZDljMTcxNWNkNDRjZDQ4NGI2ZDNhMGQzNGM4XCIsXCIyZDcwYWE0ZjY5N2MzYTNiOGRkNmQ5Nzc0NWFjMDc0ZWRjZmQwZWI2NWMzNzc3NGNkZTI1MTM1NDgzYmVhNzFlXCJdfSxcInNlbmRlcjA5XCI6W1wiYzU5ZDk4NDBiMGI2NjA5MDgzNjU0NmI3ZWI0YTczNjA2MjU3NTI3ZWM4YzJiNDgyMzAwZmQyMjkyNjRiMDdlNlwiXSxcInNlbmRlcjAzXCI6W1wiNDNmMmFkYjFkZTE5MjAwMGNiMzc3N2JhY2M3Zjk4M2I2NjE0ZmQ5YzE3MTVjZDQ0Y2Q0ODRiNmQzYTBkMzRjOFwiXSxcIm11bHRpLTAwLTAxXCI6W1wiMzY4ODIwZjgwYzMyNGJiYzdjMmIwNjEwNjg4YTdkYTQzZTM5ZjkxZDExODczMjY3MWNkOWM3NTAwZmY0M2NjYVwiLFwiNmJlMmY0ODVhN2FmNzVmZWRiNGI3ZjE1M2E5MDNmN2U2MDAwY2E0YWE1MDExNzljOTFhMjQ1MGI3NzdiZDJhN1wiXSxcInNlbmRlcjA4XCI6W1wiNjNiMmViYTRlZDcwZDQ2MTJkM2U3YmM5MGRiMmZiZjRjNzZmN2IwNzQzNjNlODZkNzNmMGJjNjE3ZjhlOGI4MVwiXSxcInNlbmRlcjAyXCI6W1wiM2E5ZGQ1MzJkNzNkYWNlMTk1ZGJiNjRkMWRiYTY1NzJmYjc4M2QwZmRkMzI0Njg1ZTMyZmJkYTJmODlmOTlhNlwiXX0sXCJjb2RlXCI6XCIoY29pbi5jb2luYmFzZSBcXFwic2VuZGVyMDBcXFwiIChyZWFkLWtleXNldCBcXFwic2VuZGVyMDBcXFwiKSAxMDAwLjApXFxuKGNvaW4uY29pbmJhc2UgXFxcInNlbmRlcjAxXFxcIiAocmVhZC1rZXlzZXQgXFxcInNlbmRlcjAxXFxcIikgMTAxMC4wKVxcbihjb2luLmNvaW5iYXNlIFxcXCJzZW5kZXIwMlxcXCIgKHJlYWQta2V5c2V0IFxcXCJzZW5kZXIwMlxcXCIpIDEwMjAuMClcXG4oY29pbi5jb2luYmFzZSBcXFwic2VuZGVyMDNcXFwiIChyZWFkLWtleXNldCBcXFwic2VuZGVyMDNcXFwiKSAxMDMwLjApXFxuKGNvaW4uY29pbmJhc2UgXFxcInNlbmRlcjA0XFxcIiAocmVhZC1rZXlzZXQgXFxcInNlbmRlcjA0XFxcIikgMTA0MC4wKVxcbihjb2luLmNvaW5iYXNlIFxcXCJzZW5kZXIwNVxcXCIgKHJlYWQta2V5c2V0IFxcXCJzZW5kZXIwNVxcXCIpIDEwNTAuMClcXG4oY29pbi5jb2luYmFzZSBcXFwic2VuZGVyMDZcXFwiIChyZWFkLWtleXNldCBcXFwic2VuZGVyMDZcXFwiKSAxMDYwLjApXFxuKGNvaW4uY29pbmJhc2UgXFxcInNlbmRlcjA3XFxcIiAocmVhZC1rZXlzZXQgXFxcInNlbmRlcjA3XFxcIikgMTA3MC4wKVxcbihjb2luLmNvaW5iYXNlIFxcXCJzZW5kZXIwOFxcXCIgKHJlYWQta2V5c2V0IFxcXCJzZW5kZXIwOFxcXCIpIDEwODAuMClcXG4oY29pbi5jb2luYmFzZSBcXFwic2VuZGVyMDlcXFwiIChyZWFkLWtleXNldCBcXFwic2VuZGVyMDlcXFwiKSAxMDkwLjApXFxuKGNvaW4uY29pbmJhc2UgXFxcIm11bHRpLTAwLTAxXFxcIiAocmVhZC1rZXlzZXQgXFxcIm11bHRpLTAwLTAxXFxcIikgMTAwMS4wKVxcbihjb2luLmNvaW5iYXNlIFxcXCJtdWx0aS0wMi0wMy0wNC1hbnlcXFwiIChyZWFkLWtleXNldCBcXFwibXVsdGktMDItMDMtMDQtYW55XFxcIikgMTIzNC4wKVwifX0sXCJtZXRhXCI6e1wiZ2FzTGltaXRcIjowLFwiY2hhaW5JZFwiOlwiXCIsXCJnYXNQcmljZVwiOjAsXCJzZW5kZXJcIjpcIlwiLFwiZmVlXCI6MH0sXCJub25jZVwiOlwiXFxcInRlc3RuZXQwMC1ncmFudHNcXFwiXCJ9In0 +- - eyJoYXNoIjoiMjVmMWI4ZTU1ODc0ZjIzNTBmMmZkNTViMGJhMzNiNGMyM2JjZWZiYmQ5MzBhYmI1MmQ1YmE2MGEzMDZmZjlmM2VjZWIxYjA0MGY4MDg3ZWNmNmIwNTk2NDFkZWMwMDIwZjMyYTdhNjBlMGUwMDQ0OWQzYzBlYmU4ZjRkMGE0ZjgiLCJzaWdzIjpbXSwiY21kIjoie1wicGF5bG9hZFwiOntcImV4ZWNcIjp7XCJkYXRhXCI6bnVsbCxcImNvZGVcIjpcIihtb2R1bGUgY29pbiBHT1ZFUk5BTkNFXFxuXFxuICBcXFwiJ2NvaW4nIHJlcHJlc2VudHMgdGhlIEthZGVuYSBDb2luIENvbnRyYWN0LlxcXCJcXG5cXG5cXG4gIDsgKGltcGxlbWVudHMgY29pbi1zaWcpXFxuICA7IChpbXBsZW1lbnRzIHNwdi1zaWcpXFxuXFxuICA7IC0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tXFxuICA7IFNjaGVtYXMgYW5kIFRhYmxlc1xcbiAgOyAtLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLVxcblxcbiAgKGRlZnNjaGVtYSBjb2luLXNjaGVtYVxcbiAgICBiYWxhbmNlOmRlY2ltYWxcXG4gICAgZ3VhcmQ6Z3VhcmRcXG4gICAgKVxcbiAgKGRlZnRhYmxlIGNvaW4tdGFibGU6e2NvaW4tc2NoZW1hfSlcXG5cXG4gIChkZWZzY2hlbWEgY3JlYXRlcy1zY2hlbWFcXG4gICAgZXhpc3RzOnN0cmluZ1xcbiAgICApXFxuICAoZGVmdGFibGUgY3JlYXRlcy10YWJsZTp7Y3JlYXRlcy1zY2hlbWF9KVxcblxcbiAgOyAtLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLVxcbiAgOyBDYXBhYmlsaXRpZXNcXG4gIDsgLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS1cXG5cXG4gIChkZWZjYXAgR09WRVJOQU5DRSAoKSAoZW5mb3JjZSBmYWxzZSBcXFwidXBncmFkZSBkaXNhYmxlZFxcXCIpKVxcblxcbiAgKGRlZmNhcCBUUkFOU0ZFUiAoKVxcbiAgICBcXFwiQXV0b25vbW91cyBjYXBhYmlsaXR5IHRvIHByb3RlY3QgZGViaXQgYW5kIGNyZWRpdCBhY3Rpb25zXFxcIlxcbiAgICB0cnVlKVxcblxcbiAgKGRlZmNhcCBDT0lOQkFTRSAoKVxcbiAgICBcXFwiTWFnaWMgY2FwYWJpbGl0eSB0byBwcm90ZWN0IG1pbmVyIHJld2FyZFxcXCJcXG4gICAgdHJ1ZSlcXG5cXG4gIChkZWZjYXAgRlVORF9UWCAoKVxcbiAgICBcXFwiTWFnaWMgY2FwYWJpbGl0eSB0byBleGVjdXRlIGdhcyBwdXJjaGFzZXMgYW5kIHJlZGVtcHRpb25zXFxcIlxcbiAgICB0cnVlKVxcblxcbiAgKGRlZmNhcCBBQ0NPVU5UX0dVQVJEIChhY2NvdW50KVxcbiAgICBcXFwiTG9va3VwIGFuZCBlbmZvcmNlIGd1YXJkcyBhc3NvY2lhdGVkIHdpdGggYW4gYWNjb3VudFxcXCJcXG4gICAgKHdpdGgtcmVhZCBjb2luLXRhYmxlIGFjY291bnQgeyBcXFwiZ3VhcmRcXFwiIDo9IGcgfVxcbiAgICAgIChlbmZvcmNlLWd1YXJkIGcpKSlcXG5cXG4gIChkZWZjYXAgR09WRVJOQU5DRSAoKVxcbiAgICAoZW5mb3JjZSBmYWxzZSBcXFwiRW5mb3JjZSBub24tdXBncmFkZWFiaWxpdHkgZXhjZXB0IGluIHRoZSBjYXNlIG9mIGEgaGFyZCBmb3JrXFxcIikpXFxuXFxuICA7IC0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tXFxuICA7IENvaW4gQ29udHJhY3RcXG4gIDsgLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS1cXG5cXG4gIChkZWZ1biBidXktZ2FzOnN0cmluZyAoc2VuZGVyOnN0cmluZyB0b3RhbDpkZWNpbWFsKVxcbiAgICBAZG9jIFxcXCJUaGlzIGZ1bmN0aW9uIGRlc2NyaWJlcyB0aGUgbWFpbiAnZ2FzIGJ1eScgb3BlcmF0aW9uLiBBdCB0aGlzIHBvaW50IFxcXFxcXG4gICAgXFxcXE1JTkVSIGhhcyBiZWVuIGNob3NlbiBmcm9tIHRoZSBwb29sLCBhbmQgd2lsbCBiZSB2YWxpZGF0ZWQuIFRoZSBTRU5ERVIgICBcXFxcXFxuICAgIFxcXFxvZiB0aGlzIHRyYW5zYWN0aW9uIGhhcyBzcGVjaWZpZWQgYSBnYXMgbGltaXQgTElNSVQgKG1heGltdW0gZ2FzKSBmb3IgICAgXFxcXFxcbiAgICBcXFxcdGhlIHRyYW5zYWN0aW9uLCBhbmQgdGhlIHByaWNlIGlzIHRoZSBzcG90IHByaWNlIG9mIGdhcyBhdCB0aGF0IHRpbWUuICAgIFxcXFxcXG4gICAgXFxcXFRoZSBnYXMgYnV5IHdpbGwgYmUgZXhlY3V0ZWQgcHJpb3IgdG8gZXhlY3V0aW5nIFNFTkRFUidzIGNvZGUuXFxcIlxcblxcbiAgICBAbW9kZWwgWyhwcm9wZXJ0eSAoPiB0b3RhbCAwLjApKV1cXG5cXG4gICAgKHJlcXVpcmUtY2FwYWJpbGl0eSAoRlVORF9UWCkpXFxuICAgICh3aXRoLWNhcGFiaWxpdHkgKFRSQU5TRkVSKVxcbiAgICAgICAoZGViaXQgc2VuZGVyIHRvdGFsKSlcXG4gICAgKVxcblxcbiAgKGRlZnVuIHJlZGVlbS1nYXM6c3RyaW5nIChtaW5lcjpzdHJpbmcgbWluZXItZ3VhcmQ6Z3VhcmQgc2VuZGVyOnN0cmluZyB0b3RhbDpkZWNpbWFsKVxcbiAgICBAZG9jIFxcXCJUaGlzIGZ1bmN0aW9uIGRlc2NyaWJlcyB0aGUgbWFpbiAncmVkZWVtIGdhcycgb3BlcmF0aW9uLiBBdCB0aGlzICAgIFxcXFxcXG4gICAgXFxcXHBvaW50LCB0aGUgU0VOREVSJ3MgdHJhbnNhY3Rpb24gaGFzIGJlZW4gZXhlY3V0ZWQsIGFuZCB0aGUgZ2FzIHRoYXQgICAgICBcXFxcXFxuICAgIFxcXFx3YXMgY2hhcmdlZCBoYXMgYmVlbiBjYWxjdWxhdGVkLiBNSU5FUiB3aWxsIGJlIGNyZWRpdGVkIHRoZSBnYXMgY29zdCwgICAgXFxcXFxcbiAgICBcXFxcYW5kIFNFTkRFUiB3aWxsIHJlY2VpdmUgdGhlIHJlbWFpbmRlciB1cCB0byB0aGUgbGltaXRcXFwiXFxuXFxuICAgIEBtb2RlbCBbKHByb3BlcnR5ICg-IHRvdGFsIDAuMCkpXVxcblxcbiAgICAocmVxdWlyZS1jYXBhYmlsaXR5IChGVU5EX1RYKSlcXG4gICAgKHdpdGgtY2FwYWJpbGl0eSAoVFJBTlNGRVIpXFxuICAgICAgKGxldCogKChmZWUgKHJlYWQtZGVjaW1hbCBcXFwiZmVlXFxcIikpXFxuICAgICAgICAgICAgIChyZWZ1bmQgKC0gdG90YWwgZmVlKSkpXFxuICAgICAgICAoZW5mb3JjZSAoPj0gcmVmdW5kIDAuMCkgXFxcImZlZSBtdXN0IGJlIGxlc3MgdGhhbiBvciBlcXVhbCB0byB0b3RhbFxcXCIpXFxuXFxuXFxuICAgICAgICA7IGRpcmVjdGx5IHVwZGF0ZSBpbnN0ZWFkIG9mIGNyZWRpdFxcbiAgICAgICAgKGlmICg-IHJlZnVuZCAwLjApXFxuICAgICAgICAgICh3aXRoLXJlYWQgY29pbi10YWJsZSBzZW5kZXJcXG4gICAgICAgICAgICB7IFxcXCJiYWxhbmNlXFxcIiA6PSBiYWxhbmNlIH1cXG4gICAgICAgICAgICAodXBkYXRlIGNvaW4tdGFibGUgc2VuZGVyXFxuICAgICAgICAgICAgICB7IFxcXCJiYWxhbmNlXFxcIjogKCsgYmFsYW5jZSByZWZ1bmQpIH0pXFxuICAgICAgICAgICAgKVxcbiAgICAgICAgICBcXFwibm9vcFxcXCIpXFxuICAgICAgICAoY3JlZGl0IG1pbmVyIG1pbmVyLWd1YXJkIGZlZSlcXG4gICAgICAgICkpXFxuICAgIClcXG5cXG4gIChkZWZ1biBjcmVhdGUtYWNjb3VudDpzdHJpbmcgKGFjY291bnQ6c3RyaW5nIGd1YXJkOmd1YXJkKVxcbiAgICBAZG9jIFxcXCJDcmVhdGUgYW4gYWNjb3VudCBmb3IgQUNDT1VOVCwgd2l0aCBBQ0NPVU5UIGFzIGEgZnVuY3Rpb24gb2YgR1VBUkRcXFwiXFxuICAgIChpbnNlcnQgY29pbi10YWJsZSBhY2NvdW50XFxuICAgICAgeyBcXFwiYmFsYW5jZVxcXCIgOiAwLjBcXG4gICAgICAsIFxcXCJndWFyZFxcXCIgICA6IGd1YXJkXFxuICAgICAgfSlcXG4gICAgKVxcblxcbiAgKGRlZnVuIGFjY291bnQtYmFsYW5jZTpkZWNpbWFsIChhY2NvdW50OnN0cmluZylcXG4gICAgQGRvYyBcXFwiUXVlcnkgYWNjb3VudCBiYWxhbmNlIGZvciBBQ0NPVU5UXFxcIlxcbiAgICAod2l0aC1jYXBhYmlsaXR5IChBQ0NPVU5UX0dVQVJEIGFjY291bnQpXFxuICAgICAgKHdpdGgtcmVhZCBjb2luLXRhYmxlIGFjY291bnRcXG4gICAgICAgIHsgXFxcImJhbGFuY2VcXFwiIDo9IGJhbGFuY2UgfVxcbiAgICAgICAgYmFsYW5jZVxcbiAgICAgICAgKSlcXG4gICAgKVxcblxcbiAgKGRlZnVuIHRyYW5zZmVyOnN0cmluZyAoc2VuZGVyOnN0cmluZyByZWNlaXZlcjpzdHJpbmcgcmVjZWl2ZXItZ3VhcmQ6Z3VhcmQgYW1vdW50OmRlY2ltYWwpXFxuICAgIEBkb2MgXFxcIlRyYW5zZmVyIGJldHdlZW4gYWNjb3VudHMgU0VOREVSIGFuZCBSRUNFSVZFUiBvbiB0aGUgc2FtZSBjaGFpbi4gICAgXFxcXFxcbiAgICBcXFxcVGhpcyBmYWlscyBpZiBib3RoIGFjY291bnRzIGRvIG5vdCBleGlzdC4gQ3JlYXRlLW9uLXRyYW5zZmVyIGNhbiBiZSAgICAgIFxcXFxcXG4gICAgXFxcXGhhbmRsZWQgYnkgc2VuZGluZyBpbiBhIGNyZWF0ZSBjb21tYW5kIGluIHRoZSBzYW1lIHR4LlxcXCJcXG5cXG4gICAgQG1vZGVsIFsocHJvcGVydHkgKD4gYW1vdW50IDAuMCkpXVxcblxcbiAgICAod2l0aC1jYXBhYmlsaXR5IChUUkFOU0ZFUilcXG4gICAgICAoZGViaXQgc2VuZGVyIGFtb3VudClcXG4gICAgICAoY3JlZGl0IHJlY2VpdmVyIHJlY2VpdmVyLWd1YXJkIGFtb3VudCkpXFxuICAgIClcXG5cXG4gIChkZWZ1biBjb2luYmFzZTpzdHJpbmcgKGFkZHJlc3M6c3RyaW5nIGFkZHJlc3MtZ3VhcmQ6Z3VhcmQgYW1vdW50OmRlY2ltYWwpXFxuICAgIEBkb2MgXFxcIk1pbnQgc29tZSBudW1iZXIgb2YgdG9rZW5zIGFuZCBhbGxvY2F0ZSB0aGVtIHRvIHNvbWUgYWRkcmVzc1xcXCJcXG4gICAgKHJlcXVpcmUtY2FwYWJpbGl0eSAoQ09JTkJBU0UpKVxcbiAgICAod2l0aC1jYXBhYmlsaXR5IChUUkFOU0ZFUilcXG4gICAgIChjcmVkaXQgYWRkcmVzcyBhZGRyZXNzLWd1YXJkIGFtb3VudCkpKVxcblxcbiAgKGRlZnBhY3QgZnVuZC10eCAoc2VuZGVyIG1pbmVyIG1pbmVyLWd1YXJkIHRvdGFsKVxcbiAgICBAZG9jIFxcXCInZnVuZC10eCcgaXMgYSBzcGVjaWFsIHBhY3QgdG8gZnVuZCBhIHRyYW5zYWN0aW9uIGluIHR3byBzdGVwcywgICAgIFxcXFxcXG4gICAgXFxcXHdpdGggdGhlIGFjdHVhbCB0cmFuc2FjdGlvbiB0cmFuc3BpcmluZyBpbiB0aGUgbWlkZGxlOiAgICAgICAgICAgICAgICAgICBcXFxcXFxuICAgIFxcXFwgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgXFxcXFxcbiAgICBcXFxcICAxKSBBIGJ1eWluZyBwaGFzZSwgZGViaXRpbmcgdGhlIHNlbmRlciBmb3IgdG90YWwgZ2FzIGFuZCBmZWUsIHlpZWxkaW5nIFxcXFxcXG4gICAgXFxcXCAgICAgVFhfTUFYX0NIQVJHRS4gICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBcXFxcXFxuICAgIFxcXFwgIDIpIEEgc2V0dGxlbWVudCBwaGFzZSwgcmVzdW1pbmcgVFhfTUFYX0NIQVJHRSwgYW5kIGFsbG9jYXRpbmcgdG8gdGhlICAgXFxcXFxcbiAgICBcXFxcICAgICBjb2luYmFzZSBhY2NvdW50IGZvciB1c2VkIGdhcyBhbmQgZmVlLCBhbmQgc2VuZGVyIGFjY291bnQgZm9yIGJhbC0gIFxcXFxcXG4gICAgXFxcXCAgICAgYW5jZSAodW51c2VkIGdhcywgaWYgYW55KS5cXFwiXFxuXFxuICAgIChzdGVwIChidXktZ2FzIHNlbmRlciB0b3RhbCkpXFxuICAgIChzdGVwIChyZWRlZW0tZ2FzIG1pbmVyIG1pbmVyLWd1YXJkIHNlbmRlciB0b3RhbCkpXFxuICAgIClcXG5cXG4gIDsgLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS1cXG4gIDsgSGVscGVyc1xcbiAgOyAtLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLVxcblxcbiAgKGRlZnVuIGRlYml0OnN0cmluZyAoYWNjb3VudDpzdHJpbmcgYW1vdW50OmRlY2ltYWwpXFxuICAgIEBkb2MgXFxcIkRlYml0IEFNT1VOVCBmcm9tIEFDQ09VTlQgYmFsYW5jZSByZWNvcmRpbmcgREFURSBhbmQgREFUQVxcXCJcXG5cXG4gICAgQG1vZGVsIFsocHJvcGVydHkgKD4gYW1vdW50IDAuMCkpXVxcblxcbiAgICAocmVxdWlyZS1jYXBhYmlsaXR5IChUUkFOU0ZFUikpXFxuICAgICh3aXRoLWNhcGFiaWxpdHkgKEFDQ09VTlRfR1VBUkQgYWNjb3VudClcXG4gICAgICAod2l0aC1yZWFkIGNvaW4tdGFibGUgYWNjb3VudFxcbiAgICAgICAgeyBcXFwiYmFsYW5jZVxcXCIgOj0gYmFsYW5jZSB9XFxuXFxuICAgICAgICAoZW5mb3JjZSAoPD0gYW1vdW50IGJhbGFuY2UpIFxcXCJJbnN1ZmZpY2llbnQgZnVuZHNcXFwiKVxcbiAgICAgICAgKHVwZGF0ZSBjb2luLXRhYmxlIGFjY291bnRcXG4gICAgICAgICAgeyBcXFwiYmFsYW5jZVxcXCIgOiAoLSBiYWxhbmNlIGFtb3VudCkgfVxcbiAgICAgICAgICApKSlcXG4gICAgKVxcblxcblxcbiAgKGRlZnVuIGNyZWRpdDpzdHJpbmcgKGFjY291bnQ6c3RyaW5nIGd1YXJkOmd1YXJkIGFtb3VudDpkZWNpbWFsKVxcbiAgICBAZG9jIFxcXCJDcmVkaXQgQU1PVU5UIHRvIEFDQ09VTlQgYmFsYW5jZSByZWNvcmRpbmcgREFURSBhbmQgREFUQVxcXCJcXG5cXG4gICAgQG1vZGVsIFsocHJvcGVydHkgKD4gYW1vdW50IDAuMCkpXVxcblxcbiAgICAocmVxdWlyZS1jYXBhYmlsaXR5IChUUkFOU0ZFUikpXFxuICAgICAgKHdpdGgtZGVmYXVsdC1yZWFkIGNvaW4tdGFibGUgYWNjb3VudFxcbiAgICAgICAgeyBcXFwiYmFsYW5jZVxcXCIgOiAwLjAsIFxcXCJndWFyZFxcXCIgOiBndWFyZCB9XFxuICAgICAgICB7IFxcXCJiYWxhbmNlXFxcIiA6PSBiYWxhbmNlLCBcXFwiZ3VhcmRcXFwiIDo9IHJldGcgfVxcbiAgICAgICAgICA7IHdlIGRvbid0IHdhbnQgdG8gb3ZlcndyaXRlIGFuIGV4aXN0aW5nIGd1YXJkIHdpdGggdGhlIHVzZXItc3VwcGxpZWQgb25lXFxuICAgICAgICAoZW5mb3JjZSAoPSByZXRnIGd1YXJkKSBcXFwiYWNjb3VudCBndWFyZHMgZG8gbm90IG1hdGNoXFxcIilcXG5cXG4gICAgICAgICh3cml0ZSBjb2luLXRhYmxlIGFjY291bnRcXG4gICAgICAgICAgeyBcXFwiYmFsYW5jZVxcXCIgOiAoKyBiYWxhbmNlIGFtb3VudClcXG4gICAgICAgICAgLCBcXFwiZ3VhcmRcXFwiICAgOiByZXRnXFxuICAgICAgICAgIH0pKVxcbiAgICAgIClcXG5cXG4gIChkZWZ1biBkZWxldGUtY29pbiAoZGVsZXRlLWFjY291bnQgY3JlYXRlLWNoYWluLWlkIGNyZWF0ZS1hY2NvdW50IGNyZWF0ZS1hY2NvdW50LWd1YXJkIHF1YW50aXR5KVxcbiAgICAod2l0aC1jYXBhYmlsaXR5IChUUkFOU0ZFUilcXG4gICAgICAoZGViaXQgZGVsZXRlLWFjY291bnQgcXVhbnRpdHkpXFxuICAgICAgeyBcXFwiY3JlYXRlLWNoYWluLWlkXFxcIjogY3JlYXRlLWNoYWluLWlkXFxuICAgICAgLCBcXFwiY3JlYXRlLWFjY291bnRcXFwiOiBjcmVhdGUtYWNjb3VudFxcbiAgICAgICwgXFxcImNyZWF0ZS1hY2NvdW50LWd1YXJkXFxcIjogY3JlYXRlLWFjY291bnQtZ3VhcmRcXG4gICAgICAsIFxcXCJxdWFudGl0eVxcXCI6IHF1YW50aXR5XFxuICAgICAgLCBcXFwiZGVsZXRlLWNoYWluLWlkXFxcIjogKGF0IFxcXCJjaGFpbi1pZFxcXCIgKGNoYWluLWRhdGEpKVxcbiAgICAgICwgXFxcImRlbGV0ZS1hY2NvdW50XFxcIjogZGVsZXRlLWFjY291bnRcXG4gICAgICAsIFxcXCJkZWxldGUtdHgtaGFzaFxcXCI6ICh0eC1oYXNoKVxcbiAgICAgIH0pKVxcblxcbiAgKGRlZnVuIGNyZWF0ZS1jb2luIChwcm9vZilcXG4gICAgKGxldCAoKG91dHB1dHMgKGF0IFxcXCJvdXRwdXRzXFxcIiAodmVyaWZ5LXNwdiBcXFwiVFhPVVRcXFwiIHByb29mKSkpKVxcbiAgICAgIChlbmZvcmNlICg9IDEgKGxlbmd0aCBvdXRwdXRzKSkgXFxcIm9ubHkgb25lIHR4IGluIG91dHB1dHNcXFwiKVxcbiAgICAgIChiaW5kIChhdCAwIG91dHB1dHMpXFxuICAgICAgICB7IFxcXCJjcmVhdGUtY2hhaW4taWRcXFwiOj0gY3JlYXRlLWNoYWluLWlkXFxuICAgICAgICAsIFxcXCJjcmVhdGUtYWNjb3VudFxcXCIgOj0gY3JlYXRlLWFjY291bnRcXG4gICAgICAgICwgXFxcImNyZWF0ZS1hY2NvdW50LWd1YXJkXFxcIiA6PSBjcmVhdGUtYWNjb3VudC1ndWFyZFxcbiAgICAgICAgLCBcXFwicXVhbnRpdHlcXFwiIDo9IHF1YW50aXR5XFxuICAgICAgICAsIFxcXCJkZWxldGUtdHgtaGFzaFxcXCIgOj0gZGVsZXRlLXR4LWhhc2hcXG4gICAgICAgICwgXFxcImRlbGV0ZS1jaGFpbi1pZFxcXCIgOj0gZGVsZXRlLWNoYWluLWlkXFxuICAgICAgICB9XFxuICAgICAgICAoZW5mb3JjZSAoPSAoYXQgXFxcImNoYWluLWlkXFxcIiAoY2hhaW4tZGF0YSkpIGNyZWF0ZS1jaGFpbi1pZCBcXFwiZW5mb3JjZSBjb3JyZWN0IGNyZWF0ZSBjaGFpbiBJRFxcXCIpKVxcbiAgICAgICAgKGxldCAoKGNyZWF0ZS1pZCAoZm9ybWF0IFxcXCIlOiVcXFwiIFtkZWxldGUtdHgtaGFzaCBkZWxldGUtY2hhaW4taWRdKSkpXFxuICAgICAgICAgICh3aXRoLWRlZmF1bHQtcmVhZCBjcmVhdGUtaWQgY3JlYXRlcy10YWJsZVxcbiAgICAgICAgICAgIHsgXFxcImV4aXN0c1xcXCI6IGZhbHNlIH1cXG4gICAgICAgICAgICB7IFxcXCJleGlzdHNcXFwiOj0gZXhpc3RzIH1cXG4gICAgICAgICAgICAoZW5mb3JjZSAobm90IGV4aXN0cykgKGZvcm1hdCBcXFwiZW5mb3JjZSB1bmlxdWUgdXNhZ2Ugb2YgJVxcXCIgW2NyZWF0ZS1pZF0pKVxcbiAgICAgICAgICAgIChpbnNlcnQgY3JlYXRlcy10YWJsZSBjcmVhdGUtaWQgeyBcXFwiZXhpc3RzXFxcIjogdHJ1ZSB9KVxcbiAgICAgICAgICAgICh3aXRoLWNhcGFiaWxpdHkgKFRSQU5TRkVSKVxcbiAgICAgICAgICAgICAgKGNyZWRpdCBjcmVhdGUtYWNjb3VudCBjcmVhdGUtYWNjb3VudC1ndWFyZCBxdWFudGl0eSkpKVxcbiAgICAgICAgICApKSlcXG4gICAgKVxcblxcblxcbilcXG5cXG4oY3JlYXRlLXRhYmxlIGNvaW4tdGFibGUpXFxuKGNyZWF0ZS10YWJsZSBjcmVhdGVzLXRhYmxlKVxcblwifX0sXCJtZXRhXCI6e1wiZ2FzTGltaXRcIjowLFwiY2hhaW5JZFwiOlwiXCIsXCJnYXNQcmljZVwiOjAsXCJzZW5kZXJcIjpcIlwifSxcIm5vbmNlXCI6XCJcXFwiZ2VuZXNpcy0wMVxcXCJcIn0ifQ + - eyJobFR4TG9ncyI6IjllMGJhMGY0YzAxNTFkMTg5YzgxNTExNWE3NjgxMTg1MjJkY2Y0MDliNWNkN2VjMzlmMTk0Y2ZmZGRhZjlkMWUxOTAxNTA2ZDk4OTE0ZWIwN2FjNzIzNGU1MjM4YmJiM2I2NmYyMDIyOGNkZTRhODA2ODk5ZTM0NzcwNzMxOGNmIiwiaGxDb21tYW5kUmVzdWx0Ijp7InN0YXR1cyI6InN1Y2Nlc3MiLCJkYXRhIjoiVGFibGVDcmVhdGVkIn19 +- - eyJoYXNoIjoiM2FkNjc1Njc3OTUzNjM0NmI3YTg5NDJkYWE2MTI5ZTA3Yjc1YWY2YjJhNWNjNjhhODAzYjA2NGM4N2Q3NTMzMTMzNTZhMWFlMjcyNWU2ODdjN2YyODU5ZDIxNmYwMmFkZDJmMmVhOGEzNDRiZGIzYzE4MTU2Y2I4YWEzYWZjZjIiLCJzaWdzIjpbXSwiY21kIjoie1wicGF5bG9hZFwiOntcImV4ZWNcIjp7XCJkYXRhXCI6e1wic2VuZGVyMDdcIjpbXCI0YzMxZGM5ZWU3ZjI0MTc3Zjc4YjZmNTE4MDEyYTIwODMyNmUyYWYxZjM3YmIwYTI0MDViNTA1NmQwY2FkNjI4XCJdLFwic2VuZGVyMDFcIjpbXCI2YmUyZjQ4NWE3YWY3NWZlZGI0YjdmMTUzYTkwM2Y3ZTYwMDBjYTRhYTUwMTE3OWM5MWEyNDUwYjc3N2JkMmE3XCJdLFwic2VuZGVyMDZcIjpbXCI1ZmZjMWY3ZmVmN2E0NDczODYyNTc2MmY3NWE0MjI5NDU0OTUxZTAzZjJhZmM2ZjgxMzA5YzBjMWJkZjllZTZmXCJdLFwic2VuZGVyMDBcIjpbXCIzNjg4MjBmODBjMzI0YmJjN2MyYjA2MTA2ODhhN2RhNDNlMzlmOTFkMTE4NzMyNjcxY2Q5Yzc1MDBmZjQzY2NhXCJdLFwic2VuZGVyMDVcIjpbXCJmMDlkOGY2Mzk0YWVhNDI1ZmU2NzgzZDg4Y2Q4MTM2M2Q4MDE3ZjE2YWZkMzcxMWM1NzViZTBmNWNkNWM5YmI5XCJdLFwic2VuZGVyMDRcIjpbXCIyZDcwYWE0ZjY5N2MzYTNiOGRkNmQ5Nzc0NWFjMDc0ZWRjZmQwZWI2NWMzNzc3NGNkZTI1MTM1NDgzYmVhNzFlXCJdLFwibXVsdGktMDItMDMtMDQtYW55XCI6e1wicHJlZFwiOlwia2V5cy1hbnlcIixcImtleXNcIjpbXCIzYTlkZDUzMmQ3M2RhY2UxOTVkYmI2NGQxZGJhNjU3MmZiNzgzZDBmZGQzMjQ2ODVlMzJmYmRhMmY4OWY5OWE2XCIsXCI0M2YyYWRiMWRlMTkyMDAwY2IzNzc3YmFjYzdmOTgzYjY2MTRmZDljMTcxNWNkNDRjZDQ4NGI2ZDNhMGQzNGM4XCIsXCIyZDcwYWE0ZjY5N2MzYTNiOGRkNmQ5Nzc0NWFjMDc0ZWRjZmQwZWI2NWMzNzc3NGNkZTI1MTM1NDgzYmVhNzFlXCJdfSxcInNlbmRlcjA5XCI6W1wiYzU5ZDk4NDBiMGI2NjA5MDgzNjU0NmI3ZWI0YTczNjA2MjU3NTI3ZWM4YzJiNDgyMzAwZmQyMjkyNjRiMDdlNlwiXSxcInNlbmRlcjAzXCI6W1wiNDNmMmFkYjFkZTE5MjAwMGNiMzc3N2JhY2M3Zjk4M2I2NjE0ZmQ5YzE3MTVjZDQ0Y2Q0ODRiNmQzYTBkMzRjOFwiXSxcIm11bHRpLTAwLTAxXCI6W1wiMzY4ODIwZjgwYzMyNGJiYzdjMmIwNjEwNjg4YTdkYTQzZTM5ZjkxZDExODczMjY3MWNkOWM3NTAwZmY0M2NjYVwiLFwiNmJlMmY0ODVhN2FmNzVmZWRiNGI3ZjE1M2E5MDNmN2U2MDAwY2E0YWE1MDExNzljOTFhMjQ1MGI3NzdiZDJhN1wiXSxcInNlbmRlcjA4XCI6W1wiNjNiMmViYTRlZDcwZDQ2MTJkM2U3YmM5MGRiMmZiZjRjNzZmN2IwNzQzNjNlODZkNzNmMGJjNjE3ZjhlOGI4MVwiXSxcInNlbmRlcjAyXCI6W1wiM2E5ZGQ1MzJkNzNkYWNlMTk1ZGJiNjRkMWRiYTY1NzJmYjc4M2QwZmRkMzI0Njg1ZTMyZmJkYTJmODlmOTlhNlwiXX0sXCJjb2RlXCI6XCIoY29pbi5jb2luYmFzZSBcXFwic2VuZGVyMDBcXFwiIChyZWFkLWtleXNldCBcXFwic2VuZGVyMDBcXFwiKSAxMDAwLjApXFxuKGNvaW4uY29pbmJhc2UgXFxcInNlbmRlcjAxXFxcIiAocmVhZC1rZXlzZXQgXFxcInNlbmRlcjAxXFxcIikgMTAxMC4wKVxcbihjb2luLmNvaW5iYXNlIFxcXCJzZW5kZXIwMlxcXCIgKHJlYWQta2V5c2V0IFxcXCJzZW5kZXIwMlxcXCIpIDEwMjAuMClcXG4oY29pbi5jb2luYmFzZSBcXFwic2VuZGVyMDNcXFwiIChyZWFkLWtleXNldCBcXFwic2VuZGVyMDNcXFwiKSAxMDMwLjApXFxuKGNvaW4uY29pbmJhc2UgXFxcInNlbmRlcjA0XFxcIiAocmVhZC1rZXlzZXQgXFxcInNlbmRlcjA0XFxcIikgMTA0MC4wKVxcbihjb2luLmNvaW5iYXNlIFxcXCJzZW5kZXIwNVxcXCIgKHJlYWQta2V5c2V0IFxcXCJzZW5kZXIwNVxcXCIpIDEwNTAuMClcXG4oY29pbi5jb2luYmFzZSBcXFwic2VuZGVyMDZcXFwiIChyZWFkLWtleXNldCBcXFwic2VuZGVyMDZcXFwiKSAxMDYwLjApXFxuKGNvaW4uY29pbmJhc2UgXFxcInNlbmRlcjA3XFxcIiAocmVhZC1rZXlzZXQgXFxcInNlbmRlcjA3XFxcIikgMTA3MC4wKVxcbihjb2luLmNvaW5iYXNlIFxcXCJzZW5kZXIwOFxcXCIgKHJlYWQta2V5c2V0IFxcXCJzZW5kZXIwOFxcXCIpIDEwODAuMClcXG4oY29pbi5jb2luYmFzZSBcXFwic2VuZGVyMDlcXFwiIChyZWFkLWtleXNldCBcXFwic2VuZGVyMDlcXFwiKSAxMDkwLjApXFxuKGNvaW4uY29pbmJhc2UgXFxcIm11bHRpLTAwLTAxXFxcIiAocmVhZC1rZXlzZXQgXFxcIm11bHRpLTAwLTAxXFxcIikgMTAwMS4wKVxcbihjb2luLmNvaW5iYXNlIFxcXCJtdWx0aS0wMi0wMy0wNC1hbnlcXFwiIChyZWFkLWtleXNldCBcXFwibXVsdGktMDItMDMtMDQtYW55XFxcIikgMTIzNC4wKVwifX0sXCJtZXRhXCI6e1wiZ2FzTGltaXRcIjowLFwiY2hhaW5JZFwiOlwiXCIsXCJnYXNQcmljZVwiOjAsXCJzZW5kZXJcIjpcIlwifSxcIm5vbmNlXCI6XCJcXFwidGVzdG5ldDAwLWdyYW50c1xcXCJcIn0ifQ - eyJobFR4TG9ncyI6Ijc5Y2NhN2QyMmRhZjNkYjI4MzY5ZDY0NjY3NWRhMjY5ZjMyNjY1MzUzYzhlYjEwZTMyZGNlMGY1YTgyNGI2YTZjMGM2ZTA0ODE3ZDFhYjYwMDY3YTdhZTU4MWRmNDdlZDJkZjIzZGJhOTMxZDU5MWYwNWY0ZTk0MWQ2YWZjYjNiIiwiaGxDb21tYW5kUmVzdWx0Ijp7InN0YXR1cyI6InN1Y2Nlc3MiLCJkYXRhIjoiV3JpdGUgc3VjY2VlZGVkIn19 minerData: eyJtIjoiTm9NaW5lciIsImtzIjpbXSwia3AiOiI8In0 -transactionsHash: zsyS6laO9hKq44nnnvrZr-h8jGGlf5F6Zs6SoTWxgPg -outputsHash: PNMiMmtcv2hASlWSf5f3tiCjUVsZcISa2jd49xjRizg -payloadHash: sETlp5mHHrLenYrLZhGZ4_dq9FiH608uBuq9fEQrp6k +transactionsHash: 0EYo9Or4PEzseVtUORuqzLtNv1lXYnAQE9UPB5--xBE +outputsHash: wjfdyJr3sEBP1UsqKYcKMDl9MZPOVe24--EMpwZKr6U +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw coinbase: eyJmbENvbW1hbmRSZXN1bHQiOnsic3RhdHVzIjoic3VjY2VzcyIsImRhdGEiOiJOT19DT0lOQkFTRSJ9LCJmbFR4TG9ncyI6W119 |] diff --git a/src/Chainweb/BlockHeader/Genesis/Testnet01.hs b/src/Chainweb/BlockHeader/Genesis/Testnet01.hs new file mode 100644 index 0000000000..57f4f23b8c --- /dev/null +++ b/src/Chainweb/BlockHeader/Genesis/Testnet01.hs @@ -0,0 +1,440 @@ +{-# LANGUAGE QuasiQuotes #-} + +-- This module is auto-generated. DO NOT EDIT IT MANUALLY. + +module Chainweb.BlockHeader.Genesis.Testnet01 where + +import Data.Text (Text) +import Data.Text.Encoding (encodeUtf8) +import Data.Yaml (decodeThrow) + +import GHC.Stack (HasCallStack) + +import NeatInterpolation (text) + +import Chainweb.BlockHeader +import Chainweb.Utils (fromJuste) + +unsafeFromYamlText :: HasCallStack => Text -> BlockHeader +unsafeFromYamlText = _objectEncoded . fromJuste . decodeThrow . encodeUtf8 + +testnet01C0 :: BlockHeader +testnet01C0 = unsafeFromYamlText + [text| +creationTime: 1555613536726767 +parent: hmqOBLvsVKKexErkDjVULKsAJtmBltU2s6iOMkqLb64 +height: 0 +hash: K8v5H56DYLMNJuoxlWu-B3Z8355IWG7YtVydICbghkw +miner: 0/12 +chainId: 12 +weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +adjacents: + '13': n85aWmf6P37Gzx0-huLjdw79xVXYxXC43jj60_3c2IA + '2': g4Z62-7kUVsBOs0x058-K_hPiTyfdzXKvbh2zLgp0JM + '11': 3ADtOzWTTd-nmDFnF4Ut1GX1nXQZL1SI8cl_0xGh_nQ +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw +chainwebVersion: testnet01 +target: ________________________________________AwA +nonce: '8772' + + |] + +testnet01C1 :: BlockHeader +testnet01C1 = unsafeFromYamlText + [text| +creationTime: 1555613536726767 +parent: n85aWmf6P37Gzx0-huLjdw79xVXYxXC43jj60_3c2IA +height: 0 +hash: KN-hqfPSDHb-nwb0P_TIN2tmMmzLeAnzSHSwSM51VGE +miner: 0/13 +chainId: 13 +weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +adjacents: + '14': Kqq4p-2aFjbePbks3KyEr3zZLM5x3UavC2FKoiCU46U + '12': hmqOBLvsVKKexErkDjVULKsAJtmBltU2s6iOMkqLb64 + '3': 8SmViUqycWoRDwYuaaxjGfU9jiaTSTdCTB0n6e8HR2E +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw +chainwebVersion: testnet01 +target: ________________________________________AwA +nonce: '4138' + + |] + +testnet01C2 :: BlockHeader +testnet01C2 = unsafeFromYamlText + [text| +creationTime: 1555613536726767 +parent: Kqq4p-2aFjbePbks3KyEr3zZLM5x3UavC2FKoiCU46U +height: 0 +hash: xwQBHcIIT3hYR-LdkJrKnTpyGbgLriqOlE0BFpf8StU +miner: 0/14 +chainId: 14 +weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +adjacents: + '13': n85aWmf6P37Gzx0-huLjdw79xVXYxXC43jj60_3c2IA + '4': N7XxTzQ6QtRFBHfbmlLuXrFY-dvhzQEe0luZcptdQck + '10': 5LZI89qDeaNKFruAh5GWT7f18R7IaegwOJNYhJPSdww +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw +chainwebVersion: testnet01 +target: ________________________________________AwA +nonce: '17720' + + |] + +testnet01C3 :: BlockHeader +testnet01C3 = unsafeFromYamlText + [text| +creationTime: 1555613536726767 +parent: z-F0gIwaZWVZg5l7tLm314q3LtDjujDEbFow-N9VbF4 +height: 0 +hash: MXZcEF-72ni98oqimbmkwlS-f7_QOwdFvE_ksiwWi2U +miner: 0/15 +chainId: 15 +weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +adjacents: + '0': 0_wArwHesJQAwgCTtQkgwFBQHumPheK5MnzjX7qbYEw + '19': iUbSRS_0oFLsPsbsicoKgiZmjmYIivUFzLz2E-Upvrs + '16': jUJ3W59bqY4Jt5YBp2Q7UrIa-c1FDyn5lxGSOzkLf60 +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw +chainwebVersion: testnet01 +target: ________________________________________AwA +nonce: '22403' + + |] + +testnet01C4 :: BlockHeader +testnet01C4 = unsafeFromYamlText + [text| +creationTime: 1555613536726767 +parent: saf6HdNU8Fwj389l2-AK5G5Y4AVRAWSwsEFjF6e6VzM +height: 0 +hash: 4NC9ppddRm7lk_50gus09DvAVQR9YYsezFFTKuVRBsQ +miner: 0/8 +chainId: 8 +weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +adjacents: + '5': 45SO7SREvayqCbt0CmlEsqcayMj2-4Pbm4JNtW8lYyo + '3': 8SmViUqycWoRDwYuaaxjGfU9jiaTSTdCTB0n6e8HR2E + '6': 3FFkRp4Phb9EtFsRj_CV5BG2CIh2hFE9WZ8EK-C3a8M +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw +chainwebVersion: testnet01 +target: ________________________________________AwA +nonce: '48122' + + |] + +testnet01C5 :: BlockHeader +testnet01C5 = unsafeFromYamlText + [text| +creationTime: 1555613536726767 +parent: DXl1TWg1zAfXp0_HPbJWdvTg-2-OhfHwLsJOGGz7_1A +height: 0 +hash: hELD-SrFo6VeEOY3asAm1iAGMWLttvJYeeEU9mwu6bw +miner: 0/9 +chainId: 9 +weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +adjacents: + '7': co_zMtp4jgoPM83U84_vdr1xVHrWv8GO15_cjHOar24 + '4': N7XxTzQ6QtRFBHfbmlLuXrFY-dvhzQEe0luZcptdQck + '6': 3FFkRp4Phb9EtFsRj_CV5BG2CIh2hFE9WZ8EK-C3a8M +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw +chainwebVersion: testnet01 +target: ________________________________________AwA +nonce: '2603' + + |] + +testnet01C6 :: BlockHeader +testnet01C6 = unsafeFromYamlText + [text| +creationTime: 1555613536726767 +parent: 5LZI89qDeaNKFruAh5GWT7f18R7IaegwOJNYhJPSdww +height: 0 +hash: HQbH5cxxUiOLJh03ceSkM9RCCyYjSM8UHfmOxqZsqnA +miner: 0/10 +chainId: 10 +weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +adjacents: + '14': Kqq4p-2aFjbePbks3KyEr3zZLM5x3UavC2FKoiCU46U + '0': 0_wArwHesJQAwgCTtQkgwFBQHumPheK5MnzjX7qbYEw + '11': 3ADtOzWTTd-nmDFnF4Ut1GX1nXQZL1SI8cl_0xGh_nQ +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw +chainwebVersion: testnet01 +target: ________________________________________AwA +nonce: '10432' + + |] + +testnet01C7 :: BlockHeader +testnet01C7 = unsafeFromYamlText + [text| +creationTime: 1555613536726767 +parent: 3ADtOzWTTd-nmDFnF4Ut1GX1nXQZL1SI8cl_0xGh_nQ +height: 0 +hash: xdzunw1IJuJ-N3qqPG9Ev7bHElbeZ2QkUUBd2pilhGw +miner: 0/11 +chainId: 11 +weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +adjacents: + '12': hmqOBLvsVKKexErkDjVULKsAJtmBltU2s6iOMkqLb64 + '1': oWNuEdDDqX9mP570wNNf8MmHEGIWUl4H25nY5mdGJrE + '10': 5LZI89qDeaNKFruAh5GWT7f18R7IaegwOJNYhJPSdww +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw +chainwebVersion: testnet01 +target: ________________________________________AwA +nonce: '4384' + + |] + +testnet01C8 :: BlockHeader +testnet01C8 = unsafeFromYamlText + [text| +creationTime: 1555613536726767 +parent: N7XxTzQ6QtRFBHfbmlLuXrFY-dvhzQEe0luZcptdQck +height: 0 +hash: v_3Dj_4MjjM16PrjpVzarSxy4N688S9LTOhHrIey0fY +miner: 0/4 +chainId: 4 +weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +adjacents: + '14': Kqq4p-2aFjbePbks3KyEr3zZLM5x3UavC2FKoiCU46U + '19': iUbSRS_0oFLsPsbsicoKgiZmjmYIivUFzLz2E-Upvrs + '9': DXl1TWg1zAfXp0_HPbJWdvTg-2-OhfHwLsJOGGz7_1A +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw +chainwebVersion: testnet01 +target: ________________________________________AwA +nonce: '60072' + + |] + +testnet01C9 :: BlockHeader +testnet01C9 = unsafeFromYamlText + [text| +creationTime: 1555613536726767 +parent: 45SO7SREvayqCbt0CmlEsqcayMj2-4Pbm4JNtW8lYyo +height: 0 +hash: _tKM35yGvTfh83-leQSKNugspCSgcgWIIVc-T6biiII +miner: 0/5 +chainId: 5 +weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +adjacents: + '7': co_zMtp4jgoPM83U84_vdr1xVHrWv8GO15_cjHOar24 + '0': 0_wArwHesJQAwgCTtQkgwFBQHumPheK5MnzjX7qbYEw + '8': saf6HdNU8Fwj389l2-AK5G5Y4AVRAWSwsEFjF6e6VzM +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw +chainwebVersion: testnet01 +target: ________________________________________AwA +nonce: '24476' + + |] + +testnet01C10 :: BlockHeader +testnet01C10 = unsafeFromYamlText + [text| +creationTime: 1555613536726767 +parent: 3FFkRp4Phb9EtFsRj_CV5BG2CIh2hFE9WZ8EK-C3a8M +height: 0 +hash: 3FefQ7BT-23UVR2g76sf1LYRAdpY9qd1AoyG7ml8zLE +miner: 0/6 +chainId: 6 +weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +adjacents: + '1': oWNuEdDDqX9mP570wNNf8MmHEGIWUl4H25nY5mdGJrE + '8': saf6HdNU8Fwj389l2-AK5G5Y4AVRAWSwsEFjF6e6VzM + '9': DXl1TWg1zAfXp0_HPbJWdvTg-2-OhfHwLsJOGGz7_1A +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw +chainwebVersion: testnet01 +target: ________________________________________AwA +nonce: '6419' + + |] + +testnet01C11 :: BlockHeader +testnet01C11 = unsafeFromYamlText + [text| +creationTime: 1555613536726767 +parent: co_zMtp4jgoPM83U84_vdr1xVHrWv8GO15_cjHOar24 +height: 0 +hash: U_h61_6oVqi6DpawgbrcHNdVTgOirXEdfD7oct7yNM4 +miner: 0/7 +chainId: 7 +weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +adjacents: + '2': g4Z62-7kUVsBOs0x058-K_hPiTyfdzXKvbh2zLgp0JM + '5': 45SO7SREvayqCbt0CmlEsqcayMj2-4Pbm4JNtW8lYyo + '9': DXl1TWg1zAfXp0_HPbJWdvTg-2-OhfHwLsJOGGz7_1A +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw +chainwebVersion: testnet01 +target: ________________________________________AwA +nonce: '23551' + + |] + +testnet01C12 :: BlockHeader +testnet01C12 = unsafeFromYamlText + [text| +creationTime: 1555613536726767 +parent: 0_wArwHesJQAwgCTtQkgwFBQHumPheK5MnzjX7qbYEw +height: 0 +hash: ThDhtVe9VLTv778WvnmCBsFuYaNPW-KsaoqllptjxQw +miner: 0/0 +chainId: 0 +weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +adjacents: + '15': z-F0gIwaZWVZg5l7tLm314q3LtDjujDEbFow-N9VbF4 + '5': 45SO7SREvayqCbt0CmlEsqcayMj2-4Pbm4JNtW8lYyo + '10': 5LZI89qDeaNKFruAh5GWT7f18R7IaegwOJNYhJPSdww +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw +chainwebVersion: testnet01 +target: ________________________________________AwA +nonce: '12094' + + |] + +testnet01C13 :: BlockHeader +testnet01C13 = unsafeFromYamlText + [text| +creationTime: 1555613536726767 +parent: jUJ3W59bqY4Jt5YBp2Q7UrIa-c1FDyn5lxGSOzkLf60 +height: 0 +hash: LiX1aHI-iiZEARXas11HhVxERifdpnbSsHs5eSm1UF4 +miner: 0/16 +chainId: 16 +weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +adjacents: + '15': z-F0gIwaZWVZg5l7tLm314q3LtDjujDEbFow-N9VbF4 + '17': 882y7Q6CWFtfpt_rSR4-Z1JjCYCAgSau9ZovTUzDd8E + '1': oWNuEdDDqX9mP570wNNf8MmHEGIWUl4H25nY5mdGJrE +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw +chainwebVersion: testnet01 +target: ________________________________________AwA +nonce: '9855' + + |] + +testnet01C14 :: BlockHeader +testnet01C14 = unsafeFromYamlText + [text| +creationTime: 1555613536726767 +parent: oWNuEdDDqX9mP570wNNf8MmHEGIWUl4H25nY5mdGJrE +height: 0 +hash: 7EIoMGnT1vy-dWEx4rwJke6thsrZd77IK_6T1gQYmDY +miner: 0/1 +chainId: 1 +weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +adjacents: + '16': jUJ3W59bqY4Jt5YBp2Q7UrIa-c1FDyn5lxGSOzkLf60 + '11': 3ADtOzWTTd-nmDFnF4Ut1GX1nXQZL1SI8cl_0xGh_nQ + '6': 3FFkRp4Phb9EtFsRj_CV5BG2CIh2hFE9WZ8EK-C3a8M +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw +chainwebVersion: testnet01 +target: ________________________________________AwA +nonce: '8913' + + |] + +testnet01C15 :: BlockHeader +testnet01C15 = unsafeFromYamlText + [text| +creationTime: 1555613536726767 +parent: 882y7Q6CWFtfpt_rSR4-Z1JjCYCAgSau9ZovTUzDd8E +height: 0 +hash: orkmQefOem9dYDWmV_OWrnLTzaXwm8f6KFv8PYfja5k +miner: 0/17 +chainId: 17 +weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +adjacents: + '18': v6fXQcA74C4q5YYmlz3tRVx63-nfx-6cwSDit1VSpjE + '16': jUJ3W59bqY4Jt5YBp2Q7UrIa-c1FDyn5lxGSOzkLf60 + '2': g4Z62-7kUVsBOs0x058-K_hPiTyfdzXKvbh2zLgp0JM +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw +chainwebVersion: testnet01 +target: ________________________________________AwA +nonce: '4099' + + |] + +testnet01C16 :: BlockHeader +testnet01C16 = unsafeFromYamlText + [text| +creationTime: 1555613536726767 +parent: g4Z62-7kUVsBOs0x058-K_hPiTyfdzXKvbh2zLgp0JM +height: 0 +hash: bJWfUjFbrzCEWOWkMsvUCtK1Oo3bHbnNZKOgj-krCsE +miner: 0/2 +chainId: 2 +weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +adjacents: + '7': co_zMtp4jgoPM83U84_vdr1xVHrWv8GO15_cjHOar24 + '12': hmqOBLvsVKKexErkDjVULKsAJtmBltU2s6iOMkqLb64 + '17': 882y7Q6CWFtfpt_rSR4-Z1JjCYCAgSau9ZovTUzDd8E +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw +chainwebVersion: testnet01 +target: ________________________________________AwA +nonce: '3532' + + |] + +testnet01C17 :: BlockHeader +testnet01C17 = unsafeFromYamlText + [text| +creationTime: 1555613536726767 +parent: v6fXQcA74C4q5YYmlz3tRVx63-nfx-6cwSDit1VSpjE +height: 0 +hash: RpMrOJqx4SgAw26S0w--saoqACs_jA74wNi47MuXXdw +miner: 0/18 +chainId: 18 +weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +adjacents: + '19': iUbSRS_0oFLsPsbsicoKgiZmjmYIivUFzLz2E-Upvrs + '17': 882y7Q6CWFtfpt_rSR4-Z1JjCYCAgSau9ZovTUzDd8E + '3': 8SmViUqycWoRDwYuaaxjGfU9jiaTSTdCTB0n6e8HR2E +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw +chainwebVersion: testnet01 +target: ________________________________________AwA +nonce: '1916' + + |] + +testnet01C18 :: BlockHeader +testnet01C18 = unsafeFromYamlText + [text| +creationTime: 1555613536726767 +parent: 8SmViUqycWoRDwYuaaxjGfU9jiaTSTdCTB0n6e8HR2E +height: 0 +hash: m6w3iDy7ynCCUypeI3b27Cuv8o2Bdzvhe8V4J1QrLak +miner: 0/3 +chainId: 3 +weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +adjacents: + '13': n85aWmf6P37Gzx0-huLjdw79xVXYxXC43jj60_3c2IA + '18': v6fXQcA74C4q5YYmlz3tRVx63-nfx-6cwSDit1VSpjE + '8': saf6HdNU8Fwj389l2-AK5G5Y4AVRAWSwsEFjF6e6VzM +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw +chainwebVersion: testnet01 +target: ________________________________________AwA +nonce: '8232' + + |] + +testnet01C19 :: BlockHeader +testnet01C19 = unsafeFromYamlText + [text| +creationTime: 1555613536726767 +parent: iUbSRS_0oFLsPsbsicoKgiZmjmYIivUFzLz2E-Upvrs +height: 0 +hash: MkFc5qEI_eR98JaDNlmlIE8iDivZyoNZnmagWyp8v_U +miner: 0/19 +chainId: 19 +weight: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +adjacents: + '15': z-F0gIwaZWVZg5l7tLm314q3LtDjujDEbFow-N9VbF4 + '18': v6fXQcA74C4q5YYmlz3tRVx63-nfx-6cwSDit1VSpjE + '4': N7XxTzQ6QtRFBHfbmlLuXrFY-dvhzQEe0luZcptdQck +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw +chainwebVersion: testnet01 +target: ________________________________________AwA +nonce: '2066' + + |] + diff --git a/src/Chainweb/BlockHeader/Genesis/Testnet01Payload.hs b/src/Chainweb/BlockHeader/Genesis/Testnet01Payload.hs new file mode 100644 index 0000000000..e2eaf1e27c --- /dev/null +++ b/src/Chainweb/BlockHeader/Genesis/Testnet01Payload.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE QuasiQuotes #-} + +-- This module is auto-generated. DO NOT EDIT IT MANUALLY. + +module Chainweb.BlockHeader.Genesis.Testnet01Payload ( payloadBlock ) where + +import Data.Text.Encoding (encodeUtf8) +import Data.Yaml (decodeThrow) + +import NeatInterpolation (text) + +import Chainweb.Payload (PayloadWithOutputs) +import Chainweb.Utils (fromJuste) + +payloadBlock :: PayloadWithOutputs +payloadBlock = fromJuste $ decodeThrow $ encodeUtf8 [text| +transactions: +- - eyJoYXNoIjoiMjVmMWI4ZTU1ODc0ZjIzNTBmMmZkNTViMGJhMzNiNGMyM2JjZWZiYmQ5MzBhYmI1MmQ1YmE2MGEzMDZmZjlmM2VjZWIxYjA0MGY4MDg3ZWNmNmIwNTk2NDFkZWMwMDIwZjMyYTdhNjBlMGUwMDQ0OWQzYzBlYmU4ZjRkMGE0ZjgiLCJzaWdzIjpbXSwiY21kIjoie1wicGF5bG9hZFwiOntcImV4ZWNcIjp7XCJkYXRhXCI6bnVsbCxcImNvZGVcIjpcIihtb2R1bGUgY29pbiBHT1ZFUk5BTkNFXFxuXFxuICBcXFwiJ2NvaW4nIHJlcHJlc2VudHMgdGhlIEthZGVuYSBDb2luIENvbnRyYWN0LlxcXCJcXG5cXG5cXG4gIDsgKGltcGxlbWVudHMgY29pbi1zaWcpXFxuICA7IChpbXBsZW1lbnRzIHNwdi1zaWcpXFxuXFxuICA7IC0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tXFxuICA7IFNjaGVtYXMgYW5kIFRhYmxlc1xcbiAgOyAtLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLVxcblxcbiAgKGRlZnNjaGVtYSBjb2luLXNjaGVtYVxcbiAgICBiYWxhbmNlOmRlY2ltYWxcXG4gICAgZ3VhcmQ6Z3VhcmRcXG4gICAgKVxcbiAgKGRlZnRhYmxlIGNvaW4tdGFibGU6e2NvaW4tc2NoZW1hfSlcXG5cXG4gIChkZWZzY2hlbWEgY3JlYXRlcy1zY2hlbWFcXG4gICAgZXhpc3RzOnN0cmluZ1xcbiAgICApXFxuICAoZGVmdGFibGUgY3JlYXRlcy10YWJsZTp7Y3JlYXRlcy1zY2hlbWF9KVxcblxcbiAgOyAtLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLVxcbiAgOyBDYXBhYmlsaXRpZXNcXG4gIDsgLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS1cXG5cXG4gIChkZWZjYXAgR09WRVJOQU5DRSAoKSAoZW5mb3JjZSBmYWxzZSBcXFwidXBncmFkZSBkaXNhYmxlZFxcXCIpKVxcblxcbiAgKGRlZmNhcCBUUkFOU0ZFUiAoKVxcbiAgICBcXFwiQXV0b25vbW91cyBjYXBhYmlsaXR5IHRvIHByb3RlY3QgZGViaXQgYW5kIGNyZWRpdCBhY3Rpb25zXFxcIlxcbiAgICB0cnVlKVxcblxcbiAgKGRlZmNhcCBDT0lOQkFTRSAoKVxcbiAgICBcXFwiTWFnaWMgY2FwYWJpbGl0eSB0byBwcm90ZWN0IG1pbmVyIHJld2FyZFxcXCJcXG4gICAgdHJ1ZSlcXG5cXG4gIChkZWZjYXAgRlVORF9UWCAoKVxcbiAgICBcXFwiTWFnaWMgY2FwYWJpbGl0eSB0byBleGVjdXRlIGdhcyBwdXJjaGFzZXMgYW5kIHJlZGVtcHRpb25zXFxcIlxcbiAgICB0cnVlKVxcblxcbiAgKGRlZmNhcCBBQ0NPVU5UX0dVQVJEIChhY2NvdW50KVxcbiAgICBcXFwiTG9va3VwIGFuZCBlbmZvcmNlIGd1YXJkcyBhc3NvY2lhdGVkIHdpdGggYW4gYWNjb3VudFxcXCJcXG4gICAgKHdpdGgtcmVhZCBjb2luLXRhYmxlIGFjY291bnQgeyBcXFwiZ3VhcmRcXFwiIDo9IGcgfVxcbiAgICAgIChlbmZvcmNlLWd1YXJkIGcpKSlcXG5cXG4gIChkZWZjYXAgR09WRVJOQU5DRSAoKVxcbiAgICAoZW5mb3JjZSBmYWxzZSBcXFwiRW5mb3JjZSBub24tdXBncmFkZWFiaWxpdHkgZXhjZXB0IGluIHRoZSBjYXNlIG9mIGEgaGFyZCBmb3JrXFxcIikpXFxuXFxuICA7IC0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tXFxuICA7IENvaW4gQ29udHJhY3RcXG4gIDsgLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS1cXG5cXG4gIChkZWZ1biBidXktZ2FzOnN0cmluZyAoc2VuZGVyOnN0cmluZyB0b3RhbDpkZWNpbWFsKVxcbiAgICBAZG9jIFxcXCJUaGlzIGZ1bmN0aW9uIGRlc2NyaWJlcyB0aGUgbWFpbiAnZ2FzIGJ1eScgb3BlcmF0aW9uLiBBdCB0aGlzIHBvaW50IFxcXFxcXG4gICAgXFxcXE1JTkVSIGhhcyBiZWVuIGNob3NlbiBmcm9tIHRoZSBwb29sLCBhbmQgd2lsbCBiZSB2YWxpZGF0ZWQuIFRoZSBTRU5ERVIgICBcXFxcXFxuICAgIFxcXFxvZiB0aGlzIHRyYW5zYWN0aW9uIGhhcyBzcGVjaWZpZWQgYSBnYXMgbGltaXQgTElNSVQgKG1heGltdW0gZ2FzKSBmb3IgICAgXFxcXFxcbiAgICBcXFxcdGhlIHRyYW5zYWN0aW9uLCBhbmQgdGhlIHByaWNlIGlzIHRoZSBzcG90IHByaWNlIG9mIGdhcyBhdCB0aGF0IHRpbWUuICAgIFxcXFxcXG4gICAgXFxcXFRoZSBnYXMgYnV5IHdpbGwgYmUgZXhlY3V0ZWQgcHJpb3IgdG8gZXhlY3V0aW5nIFNFTkRFUidzIGNvZGUuXFxcIlxcblxcbiAgICBAbW9kZWwgWyhwcm9wZXJ0eSAoPiB0b3RhbCAwLjApKV1cXG5cXG4gICAgKHJlcXVpcmUtY2FwYWJpbGl0eSAoRlVORF9UWCkpXFxuICAgICh3aXRoLWNhcGFiaWxpdHkgKFRSQU5TRkVSKVxcbiAgICAgICAoZGViaXQgc2VuZGVyIHRvdGFsKSlcXG4gICAgKVxcblxcbiAgKGRlZnVuIHJlZGVlbS1nYXM6c3RyaW5nIChtaW5lcjpzdHJpbmcgbWluZXItZ3VhcmQ6Z3VhcmQgc2VuZGVyOnN0cmluZyB0b3RhbDpkZWNpbWFsKVxcbiAgICBAZG9jIFxcXCJUaGlzIGZ1bmN0aW9uIGRlc2NyaWJlcyB0aGUgbWFpbiAncmVkZWVtIGdhcycgb3BlcmF0aW9uLiBBdCB0aGlzICAgIFxcXFxcXG4gICAgXFxcXHBvaW50LCB0aGUgU0VOREVSJ3MgdHJhbnNhY3Rpb24gaGFzIGJlZW4gZXhlY3V0ZWQsIGFuZCB0aGUgZ2FzIHRoYXQgICAgICBcXFxcXFxuICAgIFxcXFx3YXMgY2hhcmdlZCBoYXMgYmVlbiBjYWxjdWxhdGVkLiBNSU5FUiB3aWxsIGJlIGNyZWRpdGVkIHRoZSBnYXMgY29zdCwgICAgXFxcXFxcbiAgICBcXFxcYW5kIFNFTkRFUiB3aWxsIHJlY2VpdmUgdGhlIHJlbWFpbmRlciB1cCB0byB0aGUgbGltaXRcXFwiXFxuXFxuICAgIEBtb2RlbCBbKHByb3BlcnR5ICg-IHRvdGFsIDAuMCkpXVxcblxcbiAgICAocmVxdWlyZS1jYXBhYmlsaXR5IChGVU5EX1RYKSlcXG4gICAgKHdpdGgtY2FwYWJpbGl0eSAoVFJBTlNGRVIpXFxuICAgICAgKGxldCogKChmZWUgKHJlYWQtZGVjaW1hbCBcXFwiZmVlXFxcIikpXFxuICAgICAgICAgICAgIChyZWZ1bmQgKC0gdG90YWwgZmVlKSkpXFxuICAgICAgICAoZW5mb3JjZSAoPj0gcmVmdW5kIDAuMCkgXFxcImZlZSBtdXN0IGJlIGxlc3MgdGhhbiBvciBlcXVhbCB0byB0b3RhbFxcXCIpXFxuXFxuXFxuICAgICAgICA7IGRpcmVjdGx5IHVwZGF0ZSBpbnN0ZWFkIG9mIGNyZWRpdFxcbiAgICAgICAgKGlmICg-IHJlZnVuZCAwLjApXFxuICAgICAgICAgICh3aXRoLXJlYWQgY29pbi10YWJsZSBzZW5kZXJcXG4gICAgICAgICAgICB7IFxcXCJiYWxhbmNlXFxcIiA6PSBiYWxhbmNlIH1cXG4gICAgICAgICAgICAodXBkYXRlIGNvaW4tdGFibGUgc2VuZGVyXFxuICAgICAgICAgICAgICB7IFxcXCJiYWxhbmNlXFxcIjogKCsgYmFsYW5jZSByZWZ1bmQpIH0pXFxuICAgICAgICAgICAgKVxcbiAgICAgICAgICBcXFwibm9vcFxcXCIpXFxuICAgICAgICAoY3JlZGl0IG1pbmVyIG1pbmVyLWd1YXJkIGZlZSlcXG4gICAgICAgICkpXFxuICAgIClcXG5cXG4gIChkZWZ1biBjcmVhdGUtYWNjb3VudDpzdHJpbmcgKGFjY291bnQ6c3RyaW5nIGd1YXJkOmd1YXJkKVxcbiAgICBAZG9jIFxcXCJDcmVhdGUgYW4gYWNjb3VudCBmb3IgQUNDT1VOVCwgd2l0aCBBQ0NPVU5UIGFzIGEgZnVuY3Rpb24gb2YgR1VBUkRcXFwiXFxuICAgIChpbnNlcnQgY29pbi10YWJsZSBhY2NvdW50XFxuICAgICAgeyBcXFwiYmFsYW5jZVxcXCIgOiAwLjBcXG4gICAgICAsIFxcXCJndWFyZFxcXCIgICA6IGd1YXJkXFxuICAgICAgfSlcXG4gICAgKVxcblxcbiAgKGRlZnVuIGFjY291bnQtYmFsYW5jZTpkZWNpbWFsIChhY2NvdW50OnN0cmluZylcXG4gICAgQGRvYyBcXFwiUXVlcnkgYWNjb3VudCBiYWxhbmNlIGZvciBBQ0NPVU5UXFxcIlxcbiAgICAod2l0aC1jYXBhYmlsaXR5IChBQ0NPVU5UX0dVQVJEIGFjY291bnQpXFxuICAgICAgKHdpdGgtcmVhZCBjb2luLXRhYmxlIGFjY291bnRcXG4gICAgICAgIHsgXFxcImJhbGFuY2VcXFwiIDo9IGJhbGFuY2UgfVxcbiAgICAgICAgYmFsYW5jZVxcbiAgICAgICAgKSlcXG4gICAgKVxcblxcbiAgKGRlZnVuIHRyYW5zZmVyOnN0cmluZyAoc2VuZGVyOnN0cmluZyByZWNlaXZlcjpzdHJpbmcgcmVjZWl2ZXItZ3VhcmQ6Z3VhcmQgYW1vdW50OmRlY2ltYWwpXFxuICAgIEBkb2MgXFxcIlRyYW5zZmVyIGJldHdlZW4gYWNjb3VudHMgU0VOREVSIGFuZCBSRUNFSVZFUiBvbiB0aGUgc2FtZSBjaGFpbi4gICAgXFxcXFxcbiAgICBcXFxcVGhpcyBmYWlscyBpZiBib3RoIGFjY291bnRzIGRvIG5vdCBleGlzdC4gQ3JlYXRlLW9uLXRyYW5zZmVyIGNhbiBiZSAgICAgIFxcXFxcXG4gICAgXFxcXGhhbmRsZWQgYnkgc2VuZGluZyBpbiBhIGNyZWF0ZSBjb21tYW5kIGluIHRoZSBzYW1lIHR4LlxcXCJcXG5cXG4gICAgQG1vZGVsIFsocHJvcGVydHkgKD4gYW1vdW50IDAuMCkpXVxcblxcbiAgICAod2l0aC1jYXBhYmlsaXR5IChUUkFOU0ZFUilcXG4gICAgICAoZGViaXQgc2VuZGVyIGFtb3VudClcXG4gICAgICAoY3JlZGl0IHJlY2VpdmVyIHJlY2VpdmVyLWd1YXJkIGFtb3VudCkpXFxuICAgIClcXG5cXG4gIChkZWZ1biBjb2luYmFzZTpzdHJpbmcgKGFkZHJlc3M6c3RyaW5nIGFkZHJlc3MtZ3VhcmQ6Z3VhcmQgYW1vdW50OmRlY2ltYWwpXFxuICAgIEBkb2MgXFxcIk1pbnQgc29tZSBudW1iZXIgb2YgdG9rZW5zIGFuZCBhbGxvY2F0ZSB0aGVtIHRvIHNvbWUgYWRkcmVzc1xcXCJcXG4gICAgKHJlcXVpcmUtY2FwYWJpbGl0eSAoQ09JTkJBU0UpKVxcbiAgICAod2l0aC1jYXBhYmlsaXR5IChUUkFOU0ZFUilcXG4gICAgIChjcmVkaXQgYWRkcmVzcyBhZGRyZXNzLWd1YXJkIGFtb3VudCkpKVxcblxcbiAgKGRlZnBhY3QgZnVuZC10eCAoc2VuZGVyIG1pbmVyIG1pbmVyLWd1YXJkIHRvdGFsKVxcbiAgICBAZG9jIFxcXCInZnVuZC10eCcgaXMgYSBzcGVjaWFsIHBhY3QgdG8gZnVuZCBhIHRyYW5zYWN0aW9uIGluIHR3byBzdGVwcywgICAgIFxcXFxcXG4gICAgXFxcXHdpdGggdGhlIGFjdHVhbCB0cmFuc2FjdGlvbiB0cmFuc3BpcmluZyBpbiB0aGUgbWlkZGxlOiAgICAgICAgICAgICAgICAgICBcXFxcXFxuICAgIFxcXFwgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgXFxcXFxcbiAgICBcXFxcICAxKSBBIGJ1eWluZyBwaGFzZSwgZGViaXRpbmcgdGhlIHNlbmRlciBmb3IgdG90YWwgZ2FzIGFuZCBmZWUsIHlpZWxkaW5nIFxcXFxcXG4gICAgXFxcXCAgICAgVFhfTUFYX0NIQVJHRS4gICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBcXFxcXFxuICAgIFxcXFwgIDIpIEEgc2V0dGxlbWVudCBwaGFzZSwgcmVzdW1pbmcgVFhfTUFYX0NIQVJHRSwgYW5kIGFsbG9jYXRpbmcgdG8gdGhlICAgXFxcXFxcbiAgICBcXFxcICAgICBjb2luYmFzZSBhY2NvdW50IGZvciB1c2VkIGdhcyBhbmQgZmVlLCBhbmQgc2VuZGVyIGFjY291bnQgZm9yIGJhbC0gIFxcXFxcXG4gICAgXFxcXCAgICAgYW5jZSAodW51c2VkIGdhcywgaWYgYW55KS5cXFwiXFxuXFxuICAgIChzdGVwIChidXktZ2FzIHNlbmRlciB0b3RhbCkpXFxuICAgIChzdGVwIChyZWRlZW0tZ2FzIG1pbmVyIG1pbmVyLWd1YXJkIHNlbmRlciB0b3RhbCkpXFxuICAgIClcXG5cXG4gIDsgLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS1cXG4gIDsgSGVscGVyc1xcbiAgOyAtLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLVxcblxcbiAgKGRlZnVuIGRlYml0OnN0cmluZyAoYWNjb3VudDpzdHJpbmcgYW1vdW50OmRlY2ltYWwpXFxuICAgIEBkb2MgXFxcIkRlYml0IEFNT1VOVCBmcm9tIEFDQ09VTlQgYmFsYW5jZSByZWNvcmRpbmcgREFURSBhbmQgREFUQVxcXCJcXG5cXG4gICAgQG1vZGVsIFsocHJvcGVydHkgKD4gYW1vdW50IDAuMCkpXVxcblxcbiAgICAocmVxdWlyZS1jYXBhYmlsaXR5IChUUkFOU0ZFUikpXFxuICAgICh3aXRoLWNhcGFiaWxpdHkgKEFDQ09VTlRfR1VBUkQgYWNjb3VudClcXG4gICAgICAod2l0aC1yZWFkIGNvaW4tdGFibGUgYWNjb3VudFxcbiAgICAgICAgeyBcXFwiYmFsYW5jZVxcXCIgOj0gYmFsYW5jZSB9XFxuXFxuICAgICAgICAoZW5mb3JjZSAoPD0gYW1vdW50IGJhbGFuY2UpIFxcXCJJbnN1ZmZpY2llbnQgZnVuZHNcXFwiKVxcbiAgICAgICAgKHVwZGF0ZSBjb2luLXRhYmxlIGFjY291bnRcXG4gICAgICAgICAgeyBcXFwiYmFsYW5jZVxcXCIgOiAoLSBiYWxhbmNlIGFtb3VudCkgfVxcbiAgICAgICAgICApKSlcXG4gICAgKVxcblxcblxcbiAgKGRlZnVuIGNyZWRpdDpzdHJpbmcgKGFjY291bnQ6c3RyaW5nIGd1YXJkOmd1YXJkIGFtb3VudDpkZWNpbWFsKVxcbiAgICBAZG9jIFxcXCJDcmVkaXQgQU1PVU5UIHRvIEFDQ09VTlQgYmFsYW5jZSByZWNvcmRpbmcgREFURSBhbmQgREFUQVxcXCJcXG5cXG4gICAgQG1vZGVsIFsocHJvcGVydHkgKD4gYW1vdW50IDAuMCkpXVxcblxcbiAgICAocmVxdWlyZS1jYXBhYmlsaXR5IChUUkFOU0ZFUikpXFxuICAgICAgKHdpdGgtZGVmYXVsdC1yZWFkIGNvaW4tdGFibGUgYWNjb3VudFxcbiAgICAgICAgeyBcXFwiYmFsYW5jZVxcXCIgOiAwLjAsIFxcXCJndWFyZFxcXCIgOiBndWFyZCB9XFxuICAgICAgICB7IFxcXCJiYWxhbmNlXFxcIiA6PSBiYWxhbmNlLCBcXFwiZ3VhcmRcXFwiIDo9IHJldGcgfVxcbiAgICAgICAgICA7IHdlIGRvbid0IHdhbnQgdG8gb3ZlcndyaXRlIGFuIGV4aXN0aW5nIGd1YXJkIHdpdGggdGhlIHVzZXItc3VwcGxpZWQgb25lXFxuICAgICAgICAoZW5mb3JjZSAoPSByZXRnIGd1YXJkKSBcXFwiYWNjb3VudCBndWFyZHMgZG8gbm90IG1hdGNoXFxcIilcXG5cXG4gICAgICAgICh3cml0ZSBjb2luLXRhYmxlIGFjY291bnRcXG4gICAgICAgICAgeyBcXFwiYmFsYW5jZVxcXCIgOiAoKyBiYWxhbmNlIGFtb3VudClcXG4gICAgICAgICAgLCBcXFwiZ3VhcmRcXFwiICAgOiByZXRnXFxuICAgICAgICAgIH0pKVxcbiAgICAgIClcXG5cXG4gIChkZWZ1biBkZWxldGUtY29pbiAoZGVsZXRlLWFjY291bnQgY3JlYXRlLWNoYWluLWlkIGNyZWF0ZS1hY2NvdW50IGNyZWF0ZS1hY2NvdW50LWd1YXJkIHF1YW50aXR5KVxcbiAgICAod2l0aC1jYXBhYmlsaXR5IChUUkFOU0ZFUilcXG4gICAgICAoZGViaXQgZGVsZXRlLWFjY291bnQgcXVhbnRpdHkpXFxuICAgICAgeyBcXFwiY3JlYXRlLWNoYWluLWlkXFxcIjogY3JlYXRlLWNoYWluLWlkXFxuICAgICAgLCBcXFwiY3JlYXRlLWFjY291bnRcXFwiOiBjcmVhdGUtYWNjb3VudFxcbiAgICAgICwgXFxcImNyZWF0ZS1hY2NvdW50LWd1YXJkXFxcIjogY3JlYXRlLWFjY291bnQtZ3VhcmRcXG4gICAgICAsIFxcXCJxdWFudGl0eVxcXCI6IHF1YW50aXR5XFxuICAgICAgLCBcXFwiZGVsZXRlLWNoYWluLWlkXFxcIjogKGF0IFxcXCJjaGFpbi1pZFxcXCIgKGNoYWluLWRhdGEpKVxcbiAgICAgICwgXFxcImRlbGV0ZS1hY2NvdW50XFxcIjogZGVsZXRlLWFjY291bnRcXG4gICAgICAsIFxcXCJkZWxldGUtdHgtaGFzaFxcXCI6ICh0eC1oYXNoKVxcbiAgICAgIH0pKVxcblxcbiAgKGRlZnVuIGNyZWF0ZS1jb2luIChwcm9vZilcXG4gICAgKGxldCAoKG91dHB1dHMgKGF0IFxcXCJvdXRwdXRzXFxcIiAodmVyaWZ5LXNwdiBcXFwiVFhPVVRcXFwiIHByb29mKSkpKVxcbiAgICAgIChlbmZvcmNlICg9IDEgKGxlbmd0aCBvdXRwdXRzKSkgXFxcIm9ubHkgb25lIHR4IGluIG91dHB1dHNcXFwiKVxcbiAgICAgIChiaW5kIChhdCAwIG91dHB1dHMpXFxuICAgICAgICB7IFxcXCJjcmVhdGUtY2hhaW4taWRcXFwiOj0gY3JlYXRlLWNoYWluLWlkXFxuICAgICAgICAsIFxcXCJjcmVhdGUtYWNjb3VudFxcXCIgOj0gY3JlYXRlLWFjY291bnRcXG4gICAgICAgICwgXFxcImNyZWF0ZS1hY2NvdW50LWd1YXJkXFxcIiA6PSBjcmVhdGUtYWNjb3VudC1ndWFyZFxcbiAgICAgICAgLCBcXFwicXVhbnRpdHlcXFwiIDo9IHF1YW50aXR5XFxuICAgICAgICAsIFxcXCJkZWxldGUtdHgtaGFzaFxcXCIgOj0gZGVsZXRlLXR4LWhhc2hcXG4gICAgICAgICwgXFxcImRlbGV0ZS1jaGFpbi1pZFxcXCIgOj0gZGVsZXRlLWNoYWluLWlkXFxuICAgICAgICB9XFxuICAgICAgICAoZW5mb3JjZSAoPSAoYXQgXFxcImNoYWluLWlkXFxcIiAoY2hhaW4tZGF0YSkpIGNyZWF0ZS1jaGFpbi1pZCBcXFwiZW5mb3JjZSBjb3JyZWN0IGNyZWF0ZSBjaGFpbiBJRFxcXCIpKVxcbiAgICAgICAgKGxldCAoKGNyZWF0ZS1pZCAoZm9ybWF0IFxcXCIlOiVcXFwiIFtkZWxldGUtdHgtaGFzaCBkZWxldGUtY2hhaW4taWRdKSkpXFxuICAgICAgICAgICh3aXRoLWRlZmF1bHQtcmVhZCBjcmVhdGUtaWQgY3JlYXRlcy10YWJsZVxcbiAgICAgICAgICAgIHsgXFxcImV4aXN0c1xcXCI6IGZhbHNlIH1cXG4gICAgICAgICAgICB7IFxcXCJleGlzdHNcXFwiOj0gZXhpc3RzIH1cXG4gICAgICAgICAgICAoZW5mb3JjZSAobm90IGV4aXN0cykgKGZvcm1hdCBcXFwiZW5mb3JjZSB1bmlxdWUgdXNhZ2Ugb2YgJVxcXCIgW2NyZWF0ZS1pZF0pKVxcbiAgICAgICAgICAgIChpbnNlcnQgY3JlYXRlcy10YWJsZSBjcmVhdGUtaWQgeyBcXFwiZXhpc3RzXFxcIjogdHJ1ZSB9KVxcbiAgICAgICAgICAgICh3aXRoLWNhcGFiaWxpdHkgKFRSQU5TRkVSKVxcbiAgICAgICAgICAgICAgKGNyZWRpdCBjcmVhdGUtYWNjb3VudCBjcmVhdGUtYWNjb3VudC1ndWFyZCBxdWFudGl0eSkpKVxcbiAgICAgICAgICApKSlcXG4gICAgKVxcblxcblxcbilcXG5cXG4oY3JlYXRlLXRhYmxlIGNvaW4tdGFibGUpXFxuKGNyZWF0ZS10YWJsZSBjcmVhdGVzLXRhYmxlKVxcblwifX0sXCJtZXRhXCI6e1wiZ2FzTGltaXRcIjowLFwiY2hhaW5JZFwiOlwiXCIsXCJnYXNQcmljZVwiOjAsXCJzZW5kZXJcIjpcIlwifSxcIm5vbmNlXCI6XCJcXFwiZ2VuZXNpcy0wMVxcXCJcIn0ifQ + - eyJobFR4TG9ncyI6IjllMGJhMGY0YzAxNTFkMTg5YzgxNTExNWE3NjgxMTg1MjJkY2Y0MDliNWNkN2VjMzlmMTk0Y2ZmZGRhZjlkMWUxOTAxNTA2ZDk4OTE0ZWIwN2FjNzIzNGU1MjM4YmJiM2I2NmYyMDIyOGNkZTRhODA2ODk5ZTM0NzcwNzMxOGNmIiwiaGxDb21tYW5kUmVzdWx0Ijp7InN0YXR1cyI6InN1Y2Nlc3MiLCJkYXRhIjoiVGFibGVDcmVhdGVkIn19 +- - eyJoYXNoIjoiM2FkNjc1Njc3OTUzNjM0NmI3YTg5NDJkYWE2MTI5ZTA3Yjc1YWY2YjJhNWNjNjhhODAzYjA2NGM4N2Q3NTMzMTMzNTZhMWFlMjcyNWU2ODdjN2YyODU5ZDIxNmYwMmFkZDJmMmVhOGEzNDRiZGIzYzE4MTU2Y2I4YWEzYWZjZjIiLCJzaWdzIjpbXSwiY21kIjoie1wicGF5bG9hZFwiOntcImV4ZWNcIjp7XCJkYXRhXCI6e1wic2VuZGVyMDdcIjpbXCI0YzMxZGM5ZWU3ZjI0MTc3Zjc4YjZmNTE4MDEyYTIwODMyNmUyYWYxZjM3YmIwYTI0MDViNTA1NmQwY2FkNjI4XCJdLFwic2VuZGVyMDFcIjpbXCI2YmUyZjQ4NWE3YWY3NWZlZGI0YjdmMTUzYTkwM2Y3ZTYwMDBjYTRhYTUwMTE3OWM5MWEyNDUwYjc3N2JkMmE3XCJdLFwic2VuZGVyMDZcIjpbXCI1ZmZjMWY3ZmVmN2E0NDczODYyNTc2MmY3NWE0MjI5NDU0OTUxZTAzZjJhZmM2ZjgxMzA5YzBjMWJkZjllZTZmXCJdLFwic2VuZGVyMDBcIjpbXCIzNjg4MjBmODBjMzI0YmJjN2MyYjA2MTA2ODhhN2RhNDNlMzlmOTFkMTE4NzMyNjcxY2Q5Yzc1MDBmZjQzY2NhXCJdLFwic2VuZGVyMDVcIjpbXCJmMDlkOGY2Mzk0YWVhNDI1ZmU2NzgzZDg4Y2Q4MTM2M2Q4MDE3ZjE2YWZkMzcxMWM1NzViZTBmNWNkNWM5YmI5XCJdLFwic2VuZGVyMDRcIjpbXCIyZDcwYWE0ZjY5N2MzYTNiOGRkNmQ5Nzc0NWFjMDc0ZWRjZmQwZWI2NWMzNzc3NGNkZTI1MTM1NDgzYmVhNzFlXCJdLFwibXVsdGktMDItMDMtMDQtYW55XCI6e1wicHJlZFwiOlwia2V5cy1hbnlcIixcImtleXNcIjpbXCIzYTlkZDUzMmQ3M2RhY2UxOTVkYmI2NGQxZGJhNjU3MmZiNzgzZDBmZGQzMjQ2ODVlMzJmYmRhMmY4OWY5OWE2XCIsXCI0M2YyYWRiMWRlMTkyMDAwY2IzNzc3YmFjYzdmOTgzYjY2MTRmZDljMTcxNWNkNDRjZDQ4NGI2ZDNhMGQzNGM4XCIsXCIyZDcwYWE0ZjY5N2MzYTNiOGRkNmQ5Nzc0NWFjMDc0ZWRjZmQwZWI2NWMzNzc3NGNkZTI1MTM1NDgzYmVhNzFlXCJdfSxcInNlbmRlcjA5XCI6W1wiYzU5ZDk4NDBiMGI2NjA5MDgzNjU0NmI3ZWI0YTczNjA2MjU3NTI3ZWM4YzJiNDgyMzAwZmQyMjkyNjRiMDdlNlwiXSxcInNlbmRlcjAzXCI6W1wiNDNmMmFkYjFkZTE5MjAwMGNiMzc3N2JhY2M3Zjk4M2I2NjE0ZmQ5YzE3MTVjZDQ0Y2Q0ODRiNmQzYTBkMzRjOFwiXSxcIm11bHRpLTAwLTAxXCI6W1wiMzY4ODIwZjgwYzMyNGJiYzdjMmIwNjEwNjg4YTdkYTQzZTM5ZjkxZDExODczMjY3MWNkOWM3NTAwZmY0M2NjYVwiLFwiNmJlMmY0ODVhN2FmNzVmZWRiNGI3ZjE1M2E5MDNmN2U2MDAwY2E0YWE1MDExNzljOTFhMjQ1MGI3NzdiZDJhN1wiXSxcInNlbmRlcjA4XCI6W1wiNjNiMmViYTRlZDcwZDQ2MTJkM2U3YmM5MGRiMmZiZjRjNzZmN2IwNzQzNjNlODZkNzNmMGJjNjE3ZjhlOGI4MVwiXSxcInNlbmRlcjAyXCI6W1wiM2E5ZGQ1MzJkNzNkYWNlMTk1ZGJiNjRkMWRiYTY1NzJmYjc4M2QwZmRkMzI0Njg1ZTMyZmJkYTJmODlmOTlhNlwiXX0sXCJjb2RlXCI6XCIoY29pbi5jb2luYmFzZSBcXFwic2VuZGVyMDBcXFwiIChyZWFkLWtleXNldCBcXFwic2VuZGVyMDBcXFwiKSAxMDAwLjApXFxuKGNvaW4uY29pbmJhc2UgXFxcInNlbmRlcjAxXFxcIiAocmVhZC1rZXlzZXQgXFxcInNlbmRlcjAxXFxcIikgMTAxMC4wKVxcbihjb2luLmNvaW5iYXNlIFxcXCJzZW5kZXIwMlxcXCIgKHJlYWQta2V5c2V0IFxcXCJzZW5kZXIwMlxcXCIpIDEwMjAuMClcXG4oY29pbi5jb2luYmFzZSBcXFwic2VuZGVyMDNcXFwiIChyZWFkLWtleXNldCBcXFwic2VuZGVyMDNcXFwiKSAxMDMwLjApXFxuKGNvaW4uY29pbmJhc2UgXFxcInNlbmRlcjA0XFxcIiAocmVhZC1rZXlzZXQgXFxcInNlbmRlcjA0XFxcIikgMTA0MC4wKVxcbihjb2luLmNvaW5iYXNlIFxcXCJzZW5kZXIwNVxcXCIgKHJlYWQta2V5c2V0IFxcXCJzZW5kZXIwNVxcXCIpIDEwNTAuMClcXG4oY29pbi5jb2luYmFzZSBcXFwic2VuZGVyMDZcXFwiIChyZWFkLWtleXNldCBcXFwic2VuZGVyMDZcXFwiKSAxMDYwLjApXFxuKGNvaW4uY29pbmJhc2UgXFxcInNlbmRlcjA3XFxcIiAocmVhZC1rZXlzZXQgXFxcInNlbmRlcjA3XFxcIikgMTA3MC4wKVxcbihjb2luLmNvaW5iYXNlIFxcXCJzZW5kZXIwOFxcXCIgKHJlYWQta2V5c2V0IFxcXCJzZW5kZXIwOFxcXCIpIDEwODAuMClcXG4oY29pbi5jb2luYmFzZSBcXFwic2VuZGVyMDlcXFwiIChyZWFkLWtleXNldCBcXFwic2VuZGVyMDlcXFwiKSAxMDkwLjApXFxuKGNvaW4uY29pbmJhc2UgXFxcIm11bHRpLTAwLTAxXFxcIiAocmVhZC1rZXlzZXQgXFxcIm11bHRpLTAwLTAxXFxcIikgMTAwMS4wKVxcbihjb2luLmNvaW5iYXNlIFxcXCJtdWx0aS0wMi0wMy0wNC1hbnlcXFwiIChyZWFkLWtleXNldCBcXFwibXVsdGktMDItMDMtMDQtYW55XFxcIikgMTIzNC4wKVwifX0sXCJtZXRhXCI6e1wiZ2FzTGltaXRcIjowLFwiY2hhaW5JZFwiOlwiXCIsXCJnYXNQcmljZVwiOjAsXCJzZW5kZXJcIjpcIlwifSxcIm5vbmNlXCI6XCJcXFwidGVzdG5ldDAwLWdyYW50c1xcXCJcIn0ifQ + - eyJobFR4TG9ncyI6Ijc5Y2NhN2QyMmRhZjNkYjI4MzY5ZDY0NjY3NWRhMjY5ZjMyNjY1MzUzYzhlYjEwZTMyZGNlMGY1YTgyNGI2YTZjMGM2ZTA0ODE3ZDFhYjYwMDY3YTdhZTU4MWRmNDdlZDJkZjIzZGJhOTMxZDU5MWYwNWY0ZTk0MWQ2YWZjYjNiIiwiaGxDb21tYW5kUmVzdWx0Ijp7InN0YXR1cyI6InN1Y2Nlc3MiLCJkYXRhIjoiV3JpdGUgc3VjY2VlZGVkIn19 +minerData: eyJtIjoiTm9NaW5lciIsImtzIjpbXSwia3AiOiI8In0 +transactionsHash: 0EYo9Or4PEzseVtUORuqzLtNv1lXYnAQE9UPB5--xBE +outputsHash: wjfdyJr3sEBP1UsqKYcKMDl9MZPOVe24--EMpwZKr6U +payloadHash: 61j8anj3geGTgnWGPfnxN8X5lpwphWMTWFc_sdTfZlw +coinbase: eyJmbENvbW1hbmRSZXN1bHQiOnsic3RhdHVzIjoic3VjY2VzcyIsImRhdGEiOiJOT19DT0lOQkFTRSJ9LCJmbFR4TG9ncyI6W119 + +|] diff --git a/src/Chainweb/ChainId.hs b/src/Chainweb/ChainId.hs index d695d316b2..c98e59027f 100644 --- a/src/Chainweb/ChainId.hs +++ b/src/Chainweb/ChainId.hs @@ -17,11 +17,11 @@ -- Maintainer: Lars Kuhtz -- Stability: experimental -- --- TODO +-- The defininitions in this module are also exported via "Chainweb.Version". -- module Chainweb.ChainId ( ChainIdException(..) -, ChainId(..) +, ChainId , HasChainId(..) , checkChainId , chainIdToText @@ -46,7 +46,7 @@ module Chainweb.ChainId -- * Testing , unsafeChainId -, unsafeGetChainId +, chainIdInt ) where import Control.DeepSeq @@ -89,18 +89,21 @@ instance Exception ChainIdException -- -------------------------------------------------------------------------- -- -- ChainId --- | ChainId /within a Chainweb/. +-- | ChainId /within the context of a Chainweb instance/. -- --- Generally a block chain is /globally/ uniquely identified by its genesis hash. --- This type only uniquely identifies the chain /locally/ within the context of --- a chainweb. +-- The set of valid ChainIds is determined by the 'ChainwebVersion'. In almost +-- all use cases there should be a context that is an instance of +-- 'HasChainwebVersion' can be used get the set of chain ids. -- --- However, the chainweb context is globally uniquely identified by the --- 'ChainwebVersion', which in turn is determined by the identities of the --- chains in the chainweb. Since the chainweb topology is statically represented --- on the type level, while the Chainweb version is a runtime value, we break --- the cycle by using the Chainweb version as globally unique identifier and --- include the 'ChainwebVersion' and the 'ChainId' into the genesis hash. +-- In the context of a particular chain the respective 'ChainId' can be obtained +-- via instances of 'HasChainId'. +-- +-- /How to create values of type 'ChainId'/ +-- +-- * To fold or traverse over all chain ids, use 'chainIds'. +-- * To deserialize a chain id, use 'mkChainId'. +-- * For a random chain id consider using 'randomChainId'. +-- * For some arbitrary but fixed chain id consider using 'someChainId'. -- newtype ChainId :: Type where ChainId :: Word32 -> ChainId @@ -231,17 +234,19 @@ instance SingKind ChainIdT where SomeChainIdT p -> SomeSing (singByProxy p) -- -------------------------------------------------------------------------- -- --- Testing +-- Misc --- | Generally, the 'ChainId' is determined by the genesis block of a chain for --- a given 'Chainweb.Version'. This constructor is only for testing. +-- | This function should be be rarely needed. Please consult the documentation +-- of 'ChainId' for alternative ways to obtain 'ChainId' values. -- unsafeChainId :: Word32 -> ChainId unsafeChainId = ChainId {-# INLINE unsafeChainId #-} -unsafeGetChainId :: ChainId -> Word32 -unsafeGetChainId (ChainId cid) = cid +chainIdInt :: Integral i => ChainId -> i +chainIdInt (ChainId cid) = int cid +{-# INLINE chainIdInt #-} instance Arbitrary ChainId where arbitrary = unsafeChainId <$> arbitrary + diff --git a/src/Chainweb/Chainweb.hs b/src/Chainweb/Chainweb.hs index 5ae7ca3408..7a16319e89 100644 --- a/src/Chainweb/Chainweb.hs +++ b/src/Chainweb/Chainweb.hs @@ -384,8 +384,7 @@ withChainwebInternal conf logger peer payloadDb inner = do | otherwise = m [] v = _configChainwebVersion conf - graph = _chainGraph v - cids = chainIds_ graph + cids = chainIds v cwnid = _configNodeId conf chainDbDir = _configChainDbDirPath conf diff --git a/src/Chainweb/Chainweb/CutResources.hs b/src/Chainweb/Chainweb/CutResources.hs index b8d7f2e79e..a24c699053 100644 --- a/src/Chainweb/Chainweb/CutResources.hs +++ b/src/Chainweb/Chainweb/CutResources.hs @@ -53,8 +53,6 @@ import P2P.Peer import P2P.Session import P2P.TaskQueue - - -- -------------------------------------------------------------------------- -- -- Cuts Resources @@ -109,20 +107,20 @@ withCutResources cutDbConfig peer logger webchain payloadDb mgr pact f = do , _cutResLogger = logger , _cutResCutSync = CutSyncResources { _cutResSyncSession = C.syncSession v useOrigin (_peerInfo $ _peerResPeer peer) cutDb - , _cutResSyncLogger = setComponent "cut" syncLogger + , _cutResSyncLogger = addLabel ("sync", "cut") syncLogger } , _cutResHeaderSync = CutSyncResources { _cutResSyncSession = session 10 (_webBlockHeaderStoreQueue headerStore) - , _cutResSyncLogger = setComponent "header" syncLogger + , _cutResSyncLogger = addLabel ("sync", "header") syncLogger } , _cutResPayloadSync = CutSyncResources { _cutResSyncSession = session 10 (_webBlockPayloadStoreQueue payloadStore) - , _cutResSyncLogger = setComponent "payload" syncLogger + , _cutResSyncLogger = addLabel ("sync", "payload") syncLogger } } where v = _chainwebVersion webchain - syncLogger = setComponent "sync" logger + syncLogger = addLabel ("sub-component", "sync") logger useOrigin = _cutDbConfigUseOrigin cutDbConfig -- | The networks that are used by the cut DB. diff --git a/src/Chainweb/Chainweb/MinerResources.hs b/src/Chainweb/Chainweb/MinerResources.hs index 789d2e2aa6..d68f5f6e37 100644 --- a/src/Chainweb/Chainweb/MinerResources.hs +++ b/src/Chainweb/Chainweb/MinerResources.hs @@ -83,5 +83,5 @@ runMiner v m = (chooseMiner v) chooseMiner Test{} = testMiner chooseMiner TestWithTime{} = testMiner chooseMiner TestWithPow{} = powMiner - chooseMiner Simulation{} = testMiner chooseMiner Testnet00 = powMiner + chooseMiner Testnet01 = powMiner diff --git a/src/Chainweb/Chainweb/PeerResources.hs b/src/Chainweb/Chainweb/PeerResources.hs index 39ce68279d..d7bbeb930c 100644 --- a/src/Chainweb/Chainweb/PeerResources.hs +++ b/src/Chainweb/Chainweb/PeerResources.hs @@ -55,7 +55,6 @@ import System.LogLevel -- internal modules import Chainweb.Counter -import Chainweb.Graph import Chainweb.HostAddress import Chainweb.Logger import Chainweb.RestAPI.NetworkID @@ -152,7 +151,7 @@ startPeerDb_ :: ChainwebVersion -> P2pConfiguration -> IO PeerDb startPeerDb_ v conf = startPeerDb nids conf where nids = HS.map ChainNetwork cids `HS.union` HS.singleton CutNetwork - cids = chainIds_ $ _chainGraph v + cids = chainIds v withPeerDb_ :: ChainwebVersion -> P2pConfiguration -> (PeerDb -> IO a) -> IO a withPeerDb_ v conf = bracket (startPeerDb_ v conf) (stopPeerDb conf) diff --git a/src/Chainweb/Cut.hs b/src/Chainweb/Cut.hs index ac5339f98e..bc4fbc7fbd 100644 --- a/src/Chainweb/Cut.hs +++ b/src/Chainweb/Cut.hs @@ -42,6 +42,7 @@ module Chainweb.Cut , cutAdjs , lookupCutM , forkDepth +, limitCut -- * Exceptions , CutException(..) @@ -70,39 +71,16 @@ module Chainweb.Cut , joinIntoHeavier , joinIntoHeavier_ --- * Testing - -, MineFailure(..) -, testMine -, testMineWithPayload -, createNewCut -, randomChainId -, arbitraryChainGraphChainId -, giveNewWebChain - --- ** properties -, prop_cutBraiding -, prop_cutBraidingGenesis -, prop_joinBase -, prop_joinBaseMeet - -, properties_lattice -, properties_lattice_passing -, properties_cut -, properties_testMining - --- ** all passing properties -, properties +-- * Meet +, meet ) where import Control.DeepSeq -import Control.Error.Util (hush, note) import Control.Exception hiding (catch) import Control.Lens hiding ((:>)) import Control.Monad hiding (join) import Control.Monad.Catch -import Control.Monad.IO.Class import Data.Foldable import Data.Function @@ -110,12 +88,10 @@ import Data.Functor.Of import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HS import qualified Data.Heap as H -import Data.Int (Int64) import Data.Maybe (catMaybes, fromMaybe) import Data.Monoid import Data.Ord import Data.Reflection hiding (int) -import Data.Tuple.Strict (T2(..)) import GHC.Generics (Generic) import GHC.Stack @@ -124,34 +100,19 @@ import Numeric.Natural import Prelude hiding (lookup) -import qualified QuickCheck.GenT as TT - import qualified Streaming.Prelude as S -import System.Random - -import qualified Test.QuickCheck as T -import qualified Test.QuickCheck.Monadic as T - -- internal modules import Chainweb.BlockHash import Chainweb.BlockHeader -import Chainweb.BlockHeader.Genesis (genesisBlockHeaders, genesisBlockTarget) +import Chainweb.BlockHeader.Genesis (genesisBlockHeaders) import Chainweb.ChainId -import Chainweb.Difficulty (HashTarget, checkTarget) import Chainweb.Graph -import Chainweb.NodeId -import Chainweb.Payload -import Chainweb.Payload.PayloadStore -import Chainweb.Time (Time, getCurrentTimeIntegral, second) import Chainweb.TreeDB hiding (properties) import Chainweb.Utils import Chainweb.Version import Chainweb.WebBlockHeaderDB -import Chainweb.WebPactExecutionService - -import Numeric.AffineSpace -- -------------------------------------------------------------------------- -- -- Cut @@ -207,7 +168,7 @@ lookupCutM -> m BlockHeader lookupCutM cid c = firstOf (ixg (_chainId cid)) c ??? ChainNotInChainGraphException - (Expected $ chainIds_ $ _chainGraph c) + (Expected $ chainIds c) (Actual (_chainId cid)) _cutWeight :: Cut -> BlockWeight @@ -244,6 +205,29 @@ cutAdjs c cid = HM.intersection (_cutHeaders c) (HS.toMap (adjacentChainIds (_chainGraph c) cid)) +-- -------------------------------------------------------------------------- -- +-- Limit Cut Hashes By Height + +limitCut + :: HasCallStack + => WebBlockHeaderDb + -> BlockHeight + -- upper bound for the cut height. This is not a tight bound. + -> Cut + -> IO Cut +limitCut wdb h c = c & (cutHeaders . itraverse) f + where + ch = h `div` int (order (_chainGraph wdb)) + f cid x = do + db <- give wdb $ getWebBlockHeaderDb cid + a <- S.head_ $ branchEntries db + Nothing (Just 1) + Nothing (Just $ int ch) + mempty (HS.singleton $ UpperBound $ _blockHash x) + return $ fromJuste a + -- this is safe because branchEntries returns at least + -- the genesis block + -- -------------------------------------------------------------------------- -- -- Genesis Cut @@ -385,12 +369,12 @@ data Join a = Join join :: Ord a - => Given WebBlockHeaderDb - => (DiffItem BlockHeader -> DiffItem (Maybe a)) + => WebBlockHeaderDb + -> (DiffItem BlockHeader -> DiffItem (Maybe a)) -> Cut -> Cut -> IO (Join a) -join f = join_ f `on` _cutHeaders +join wdb f = join_ wdb f `on` _cutHeaders -- | This merges two maps from ChainIds to BlockHeaders such that the result -- is a Cut. Note, however, that the resulting cut contains only the chain ids @@ -399,21 +383,21 @@ join f = join_ f `on` _cutHeaders join_ :: forall a . Ord a - => Given WebBlockHeaderDb - => (DiffItem BlockHeader -> DiffItem (Maybe a)) + => WebBlockHeaderDb + -> (DiffItem BlockHeader -> DiffItem (Maybe a)) -> HM.HashMap ChainId BlockHeader -> HM.HashMap ChainId BlockHeader -> IO (Join a) -join_ prioFun a b = do +join_ wdb prioFun a b = do (m, h) <- foldM f (mempty, mempty) (zipChainIdMaps a b) - return $ Join (Cut m (_chainwebVersion @WebBlockHeaderDb given)) h + return $ Join (Cut m (_chainwebVersion wdb)) h where f :: (HM.HashMap ChainId BlockHeader, JoinQueue a) -> (ChainId, BlockHeader, BlockHeader) -> IO (HM.HashMap ChainId BlockHeader, JoinQueue a) f (m, q) (cid, x, y) = do - db <- getWebBlockHeaderDb cid + db <- give wdb $ getWebBlockHeaderDb cid (q' :> h) <- S.fold g q id $ branchDiff_ db x y return (HM.insert cid h m, q') @@ -462,19 +446,19 @@ applyJoin m = foldM (_joinQueue m) joinIntoHeavier - :: Given WebBlockHeaderDb - => Cut + :: WebBlockHeaderDb + -> Cut -> Cut -> IO Cut -joinIntoHeavier = joinIntoHeavier_ `on` _cutHeaders +joinIntoHeavier wdb = joinIntoHeavier_ wdb `on` _cutHeaders joinIntoHeavier_ - :: Given WebBlockHeaderDb - => HM.HashMap ChainId BlockHeader + :: WebBlockHeaderDb + -> HM.HashMap ChainId BlockHeader -> HM.HashMap ChainId BlockHeader -> IO Cut -joinIntoHeavier_ a b = do - m <- join_ (prioritizeHeavier_ a b) a b +joinIntoHeavier_ wdb a b = do + m <- join_ wdb (prioritizeHeavier_ a b) a b applyJoin m prioritizeHeavier :: Cut -> Cut -> DiffItem BlockHeader -> DiffItem (Maybe Int) @@ -521,556 +505,28 @@ prioritizeHeavier_ a b = f -- | Intersection of cuts -- meet - :: Given WebBlockHeaderDb - => Cut + :: WebBlockHeaderDb + -> Cut -> Cut -> IO Cut -meet a b = do +meet wdb a b = do r <- HM.fromList <$> mapM f (zipCuts a b) - return $ Cut r (_chainwebVersion @WebBlockHeaderDb given) + return $ Cut r (_chainwebVersion wdb) where f (cid, x, y) = (cid,) <$> do - db <- getWebBlockHeaderDb cid + db <- give wdb $ getWebBlockHeaderDb cid forkEntry db x y forkDepth - :: Given WebBlockHeaderDb - => Cut + :: WebBlockHeaderDb + -> Cut -> Cut -> IO Natural -forkDepth a b = do - m <- meet a b +forkDepth wdb a b = do + m <- meet wdb a b return . int $ max (maxDepth m a) (maxDepth m b) where maxDepth l u = maximum $ (\(_, x, y) -> _blockHeight y - _blockHeight x) <$> zipCuts l u --- -------------------------------------------------------------------------- -- --- TESTING --- -------------------------------------------------------------------------- -- - --- -------------------------------------------------------------------------- -- --- Test Mining - -data MineFailure = BadNonce | BadAdjacents - --- Try to mine a new block header on the given chain for the given cut. --- Returns 'Nothing' if mining isn't possible because of missing adjacent --- dependencies. --- -testMine - :: forall cid - . HasChainId cid - => Given WebBlockHeaderDb - => Nonce - -> HashTarget - -> Time Int64 - -> BlockPayloadHash - -> NodeId - -> cid - -> Cut - -> IO (Either MineFailure (T2 BlockHeader Cut)) -testMine n target t payloadHash nid i c = - forM (createNewCut n target t payloadHash nid i c) $ \p@(T2 h _) -> - p <$ insertWebBlockHeaderDb h - -testMineWithPayload - :: forall cas cid - . HasChainId cid - => PayloadCas cas - => Given WebBlockHeaderDb - => Given (PayloadDb cas) - => Nonce - -> HashTarget - -> Time Int64 - -> PayloadWithOutputs - -> NodeId - -> cid - -> Cut - -> PactExecutionService - -> IO (Either MineFailure (T2 BlockHeader Cut)) -testMineWithPayload n target t payload nid i c pact = - forM (createNewCut n target t payloadHash nid i c) $ \p@(T2 h _) -> do - validatePayload h payload - addNewPayload (given @(PayloadDb cas)) payload - insertWebBlockHeaderDb h - return p - where - payloadHash = _payloadWithOutputsPayloadHash payload - - validatePayload :: BlockHeader -> PayloadWithOutputs -> IO () - validatePayload h o = void $ _pactValidateBlock pact h $ toPayloadData o - - toPayloadData PayloadWithOutputs{..} = PayloadData - { _payloadDataTransactions = fst <$> _payloadWithOutputsTransactions - , _payloadDataMiner = _payloadWithOutputsMiner - , _payloadDataPayloadHash = _payloadWithOutputsPayloadHash - , _payloadDataTransactionsHash = _payloadWithOutputsTransactionsHash - , _payloadDataOutputsHash = _payloadWithOutputsOutputsHash - } --- | Create a new block. Only produces a new cut but doesn't insert it into the --- chain database. --- -createNewCut - :: HasCallStack - => HasChainId cid - => Nonce - -> HashTarget - -> Time Int64 - -> BlockPayloadHash - -> NodeId - -> cid - -> Cut - -> Either MineFailure (T2 BlockHeader Cut) -createNewCut n target t pay nid i c = do - h <- note BadAdjacents $ newHeader . BlockHashRecord <$> newAdjHashes - unless (checkTarget target $ _blockPow h) $ Left BadNonce - return $ T2 h (c & cutHeaders . ix cid .~ h) - where - cid = _chainId i - - -- | The parent block to mine on. - -- - p :: BlockHeader - p = c ^?! ixg cid - - newHeader :: BlockHashRecord -> BlockHeader - newHeader as = testBlockHeader' (nodeIdFromNodeId nid cid) as pay n target t p - - -- | Try to get all adjacent hashes dependencies. - -- - newAdjHashes :: Maybe (HM.HashMap ChainId BlockHash) - newAdjHashes = iforM (_getBlockHashRecord $ _blockAdjacentHashes p) $ \xcid _ -> - c ^?! ixg xcid . to (tryAdj (_blockHeight p)) - - tryAdj :: BlockHeight -> BlockHeader -> Maybe BlockHash - tryAdj h b - | _blockHeight b == h = Just $! _blockHash b - | _blockHeight b == h + 1 = Just $! _blockParent b - | otherwise = Nothing - --- | Create a new cut where the new block has a creation time of one second --- after its parent. --- -createNewCutWithoutTime - :: HasCallStack - => HasChainId cid - => Nonce - -> HashTarget - -> BlockPayloadHash - -> NodeId - -> cid - -> Cut - -> Maybe (T2 BlockHeader Cut) -createNewCutWithoutTime n target pay nid i c - = hush $ createNewCut n target (add second t) pay nid i c - where - cid = _chainId i - BlockCreationTime t = _blockCreationTime $ c ^?! ixg cid - -randomChainId :: HasChainGraph g => g -> IO ChainId -randomChainId g = (!!) (toList cs) <$> randomRIO (0, length cs - 1) - where - cs = give (_chainGraph g) chainIds - --- -------------------------------------------------------------------------- -- --- Arbitrary Cuts - -arbitraryCut - :: HasCallStack - => ChainwebVersion - -> T.Gen Cut -arbitraryCut v = T.sized $ \s -> do - k <- T.choose (0,s) - foldlM (\c _ -> genCut c) (genesisCut v) [0..(k-1)] - where - genCut :: Cut -> T.Gen Cut - genCut c = do - cids <- T.shuffle (toList $ chainIds_ $ _chainGraph v) - S.each cids - & S.mapMaybeM (mine c) - & S.map (\(T2 _ x) -> x) - & S.head_ - & fmap fromJuste - - mine :: Cut -> ChainId -> T.Gen (Maybe (T2 BlockHeader Cut)) - mine c cid = do - n <- Nonce <$> T.arbitrary - nid <- T.arbitrary - let pay = hashPayload v cid "TEST PAYLOAD" - return $ createNewCutWithoutTime n target pay nid cid c - - target = genesisBlockTarget v - -arbitraryChainGraphChainId :: Given ChainGraph => T.Gen ChainId -arbitraryChainGraphChainId = T.elements (toList chainIds) - -instance Given ChainwebVersion => T.Arbitrary Cut where - arbitrary = arbitraryCut given - --- | Provide option to provide db with a branch/cut. --- -arbitraryWebChainCut - :: HasCallStack - => Given WebBlockHeaderDb - => Cut - -- @genesisCut Test@ is always a valid cut - -> T.PropertyM IO Cut -arbitraryWebChainCut initialCut = do - k <- T.pick $ T.sized $ \s -> T.choose (0,s) - foldlM (\c _ -> genCut c) initialCut [0..(k-1)] - where - genCut c = do - cids <- T.pick - $ T.shuffle - $ toList - $ chainIds_ - $ _chainGraph @WebBlockHeaderDb given - S.each cids - & S.mapMaybeM (mine c) - & S.map (\(T2 _ c') -> c') - & S.head_ - & fmap fromJuste - - mine c cid = do - n <- T.pick $ Nonce <$> T.arbitrary - nid <- T.pick T.arbitrary - t <- liftIO getCurrentTimeIntegral - let pay = hashPayload v cid "TEST PAYLOAD" - liftIO $ hush <$> testMine n target t pay nid cid c - - target = genesisBlockTarget v - v = Test (_chainGraph @WebBlockHeaderDb given) - -arbitraryWebChainCut_ - :: HasCallStack - => Given WebBlockHeaderDb - => Cut - -- @genesisCut Test@ is always a valid cut - -> TT.GenT IO Cut -arbitraryWebChainCut_ initialCut = do - k <- TT.sized $ \s -> TT.choose (0,s) - foldlM (\c _ -> genCut c) initialCut [0..(k-1)] - where - genCut c = do - cids <- TT.liftGen - $ T.shuffle - $ toList - $ chainIds_ - $ _chainGraph @WebBlockHeaderDb given - S.each cids - & S.mapMaybeM (fmap hush . mine c) - & S.map (\(T2 _ c') -> c') - & S.head_ - & fmap fromJuste - - mine c cid = do - n <- Nonce <$> TT.liftGen T.arbitrary - nid <- TT.liftGen T.arbitrary - t <- liftIO getCurrentTimeIntegral - let pay = hashPayload v cid "TEST PAYLOAD" - liftIO $ testMine n target t pay nid cid c - - target = genesisBlockTarget v - v = Test $ _chainGraph @WebBlockHeaderDb given - --- -------------------------------------------------------------------------- -- --- Arbitrary Fork - -testGenCut :: Given WebBlockHeaderDb => Cut -testGenCut = genesisCut $ Test $ _chainGraph @WebBlockHeaderDb given - -data TestFork = TestFork - { _testForkBase :: !Cut - , _testForkLeft :: !Cut - , _testForkRight :: !Cut - } - deriving (Show, Eq, Ord, Generic) - -instance (Given WebBlockHeaderDb) => T.Arbitrary (IO TestFork) where - arbitrary = TT.runGenT arbitraryFork_ - -instance (Given WebBlockHeaderDb) => T.Arbitrary (IO (Join Int)) where - arbitrary = TT.runGenT $ do - TestFork _ cl cr <- arbitraryFork_ - liftIO $ join (prioritizeHeavier cl cr) cl cr - --- | Fork point is the genesis cut --- --- TODO: provide option to fork of elsewhere --- -arbitraryFork - :: Given WebBlockHeaderDb - => T.PropertyM IO TestFork -arbitraryFork = do - base <- arbitraryWebChainCut testGenCut - TestFork base - <$> arbitraryWebChainCut base - <*> arbitraryWebChainCut base - -arbitraryFork_ - :: Given WebBlockHeaderDb - => TT.GenT IO TestFork -arbitraryFork_ = do - base <- arbitraryWebChainCut_ testGenCut - TestFork base - <$> arbitraryWebChainCut_ base - <*> arbitraryWebChainCut_ base - --- -------------------------------------------------------------------------- -- --- 'meet' and 'join' form a lattice with genesisCut as bottom --- --- The order of the lattice is conistent with the weight order. --- --- Note: --- --- * The non-optimal join function 'joinIntoHeavier' doesn't satisfy the lattice --- laws In particular associativity. However it must satisfy commutativity, --- for reasonably fast convergence. --- --- * 'joinIntoHeavier' is likely to be optimal on low diameter graphs even for --- relatively small test instance size parameters, because it is optimal when --- a fork on a chain is longer than the diameter.) --- --- * for fork of depth 1 'joinIntoHeavier' is not a good strategy. --- --- * TODO: properties about consistency of order --- - --- Join - -prop_joinIdempotent - :: Given WebBlockHeaderDb - => T.PropertyM IO Bool -prop_joinIdempotent = do - c <- arbitraryWebChainCut testGenCut - T.run $ (==) c <$> joinIntoHeavier c c - --- FIXME! -prop_joinCommutative - :: Given WebBlockHeaderDb - => T.PropertyM IO Bool -prop_joinCommutative = do - TestFork _ cl cr <- arbitraryFork - T.run $ (==) - <$> joinIntoHeavier cl cr - <*> joinIntoHeavier cr cl - --- Fails for heuristic joins --- -prop_joinAssociative - :: Given WebBlockHeaderDb - => T.PropertyM IO Bool -prop_joinAssociative = do - TestFork _ c0 c1 <- arbitraryFork - TestFork _ c10 c11 <- TestFork c1 - <$> arbitraryWebChainCut c1 - <*> arbitraryWebChainCut c1 - - -- d0 <- T.run $ forkDepth c10 c11 - -- T.pre (diameter (given @ChainGraph) <= d0) - -- T.monitor (T.counterexample $ "fork depth: " <> sshow d0) - -- d1 <- T.run $ forkDepth c0 c10 - -- T.pre (diameter (given @ChainGraph) <= d1) - -- T.monitor (T.counterexample $ "fork depth: " <> sshow d1) - - T.run $ do - let m = joinIntoHeavier - (==) - <$> (m c0 =<< m c10 c11) - <*> (m c0 c10 >>= \x -> m x c11) - -prop_joinIdentity - :: Given WebBlockHeaderDb - => T.PropertyM IO Bool -prop_joinIdentity = do - c <- arbitraryWebChainCut testGenCut - T.run $ (==) c <$> joinIntoHeavier testGenCut c - --- Meet - -prop_meetIdempotent - :: Given WebBlockHeaderDb - => T.PropertyM IO Bool -prop_meetIdempotent = do - c <- arbitraryWebChainCut testGenCut - T.run $ (==) c <$> meet c c - -prop_meetCommutative - :: Given WebBlockHeaderDb - => T.PropertyM IO Bool -prop_meetCommutative = do - TestFork _ cl cr <- arbitraryFork - T.run $ (==) - <$> meet cl cr - <*> meet cr cl - -prop_meetAssociative - :: Given WebBlockHeaderDb - => T.PropertyM IO Bool -prop_meetAssociative = do - TestFork _ c0 c1 <- arbitraryFork - TestFork _ c10 c11 <- TestFork c1 - <$> arbitraryWebChainCut c1 - <*> arbitraryWebChainCut c1 - T.run $ do - let m = meet - (==) - <$> (m c0 =<< m c10 c11) - <*> (m c0 c10 >>= \x -> m x c11) - --- | this a corollary of 'prop_joinIdentity' and 'prop_meetJoinAbsorption' --- -prop_meetZeroAbsorption - :: Given WebBlockHeaderDb - => T.PropertyM IO Bool -prop_meetZeroAbsorption = do - c <- arbitraryWebChainCut testGenCut - T.run $ do - c' <- meet testGenCut c - return (c == c') - -prop_joinMeetAbsorption - :: Given WebBlockHeaderDb - => T.PropertyM IO Bool -prop_joinMeetAbsorption = do - TestFork _ c0 c1 <- arbitraryFork - T.run $ do - c0' <- joinIntoHeavier c0 =<< meet c0 c1 - return (c0' == c0) - -prop_meetJoinAbsorption - :: Given WebBlockHeaderDb - => T.PropertyM IO Bool -prop_meetJoinAbsorption = do - TestFork _ c0 c1 <- arbitraryFork - T.run $ do - c0' <- meet c0 =<< joinIntoHeavier c0 c1 - return (c0' == c0) - -properties_lattice :: ChainwebVersion -> [(String, T.Property)] -properties_lattice v = - [ ("joinIdemPotent", ioTest v prop_joinIdempotent) - , ("joinCommutative", ioTest v prop_joinCommutative) - , ("joinAssociative", ioTest v prop_joinAssociative) -- Fails - , ("joinIdentity", ioTest v prop_joinIdentity) - - , ("meetIdemPotent", ioTest v prop_meetIdempotent) - , ("meetCommutative", ioTest v prop_meetCommutative) - , ("meetAssociative", ioTest v prop_meetAssociative) - , ("meetZeroAbsorption", ioTest v prop_meetZeroAbsorption) -- Fails - - , ("joinMeetAbsorption", ioTest v prop_joinMeetAbsorption) - , ("meetJoinAbsorption", ioTest v prop_meetJoinAbsorption) -- Fails - ] - -properties_lattice_passing :: ChainwebVersion -> [(String, T.Property)] -properties_lattice_passing v = - [ ("joinIdemPotent", ioTest v prop_joinIdempotent) - , ("joinCommutative", ioTest v prop_joinCommutative) - , ("joinIdentity", ioTest v prop_joinIdentity) - - , ("meetIdemPotent", ioTest v prop_meetIdempotent) - , ("meetCommutative", ioTest v prop_meetCommutative) - , ("meetAssociative", ioTest v prop_meetAssociative) - - , ("joinMeetAbsorption", ioTest v prop_joinMeetAbsorption) - ] - --- -------------------------------------------------------------------------- -- --- Cut Properties - -prop_cutBraiding :: Cut -> Bool -prop_cutBraiding = either throw (const True) . checkBraidingOfCut - -prop_cutBraidingGenesis :: ChainwebVersion -> Bool -prop_cutBraidingGenesis v = either throw (const True) - $ checkBraidingOfCut (genesisCut v) - --- TODO --- --- * cuts are partially ordered with respect to parent and parent hashes --- * partial order is consistent with weight and blockheight --- --- * this order induces a lattice - -properties_cut :: ChainwebVersion -> [(String, T.Property)] -properties_cut v = - [ ("Cut has valid braiding", give v $ T.property prop_cutBraiding) - , ("Genesis Cut has valid braiding", T.property (prop_cutBraidingGenesis v)) - ] - --- -------------------------------------------------------------------------- -- --- Meet Properties - -prop_meetGenesisCut :: Given WebBlockHeaderDb => T.PropertyM IO Bool -prop_meetGenesisCut = liftIO $ (==) c <$> meet c c - where - c = testGenCut - --- -------------------------------------------------------------------------- -- --- Misc Properties - -prop_arbitraryForkBraiding :: ChainwebVersion -> T.Property -prop_arbitraryForkBraiding v = ioTest v $ give (_chainGraph v) $ do - TestFork b cl cr <- arbitraryFork - T.assert (prop_cutBraiding b) - T.assert (prop_cutBraiding cl) - T.assert (prop_cutBraiding cr) - return True - -prop_joinBase :: ChainwebVersion -> T.Property -prop_joinBase v = ioTest v $ do - TestFork b cl cr <- arbitraryFork - m <- liftIO $ join (prioritizeHeavier cl cr) cl cr - return (_joinBase m == b) - -prop_joinBaseMeet :: ChainwebVersion -> T.Property -prop_joinBaseMeet v = ioTest v $ do - TestFork _ a b <- arbitraryFork - liftIO $ (==) - <$> meet a b - <*> (_joinBase <$> join (prioritizeHeavier a b) a b) - -properties_testMining :: ChainwebVersion -> [(String, T.Property)] -properties_testMining v = - [ ("Cuts of arbitrary fork have valid braiding", prop_arbitraryForkBraiding v)] - -properties_misc :: ChainwebVersion -> [(String, T.Property)] -properties_misc v = - [ ("prop_joinBase", prop_joinBase v) - , ("prop_joinBaseMeet", prop_joinBaseMeet v) - , ("prop_meetGenesisCut", ioTest v prop_meetGenesisCut) - , ("Cuts of arbitrary fork have valid braiding", prop_arbitraryForkBraiding v) - ] - --- -------------------------------------------------------------------------- -- --- "Valid" Properties - -properties :: [(String, T.Property)] -properties - = properties_lattice_passing v - <> properties_cut v - <> properties_testMining v - <> properties_misc v - where - v = Test pairChainGraph - --- -------------------------------------------------------------------------- -- --- TestTools - -giveNewWebChain - :: MonadIO m - => ChainwebVersion - -> (Given WebBlockHeaderDb => m a) - -> m a -giveNewWebChain v f = do - db <- liftIO (initWebBlockHeaderDb v) - give db f - -ioTest - :: ChainwebVersion - -> (Given WebBlockHeaderDb => T.PropertyM IO Bool) - -> T.Property -ioTest v f = T.monadicIO $ giveNewWebChain v $ f >>= T.assert diff --git a/src/Chainweb/Cut/CutHashes.hs b/src/Chainweb/Cut/CutHashes.hs index 0a74c05d58..5f70a1784b 100644 --- a/src/Chainweb/Cut/CutHashes.hs +++ b/src/Chainweb/Cut/CutHashes.hs @@ -1,9 +1,13 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} -- | -- Module: Chainweb.Cut.CutHashes @@ -12,24 +16,59 @@ -- Maintainer: Lars Kuhtz -- Stability: experimental -- --- TODO --- module Chainweb.Cut.CutHashes ( -- * CutHashes CutHashes(..) +, cutHashes +, cutHashesChainwebVersion +, cutOrigin +, cutHashesWeight +, cutHashesHeight , cutToCutHashes + +-- * Cut Id +, CutId +, cutIdBytes +, encodeCutId +, decodeCutId +, cutIdToText +, cutIdFromText +, cutIdToTextShort + +-- * HasCutId +, HasCutId(..) ) where import Control.Arrow import Control.DeepSeq +import Control.Lens (Getter, to, view, makeLenses) +import Control.Monad.Catch + +import qualified Crypto.Hash as C +import Crypto.Hash.Algorithms import Data.Aeson +import Data.Bits +import qualified Data.ByteArray as BA +import Data.Bytes.Get +import Data.Bytes.Put +import qualified Data.ByteString.Short as SB +import Data.Foldable import Data.Function import Data.Hashable import qualified Data.HashMap.Strict as HM +import Data.Proxy +import qualified Data.Text as T + +import Foreign.Storable -import GHC.Generics +import GHC.Generics (Generic) +import GHC.TypeNats + +import Numeric.Natural + +import System.IO.Unsafe -- internal modules @@ -37,6 +76,7 @@ import Chainweb.BlockHash import Chainweb.BlockHeader import Chainweb.ChainId import Chainweb.Cut +import Chainweb.Utils import Chainweb.Version import P2P.Peer @@ -55,6 +95,8 @@ data CutHashes = CutHashes deriving (Show, Eq, Generic) deriving anyclass (Hashable, NFData) +makeLenses ''CutHashes + instance Ord CutHashes where compare = compare `on` (_cutHashesWeight &&& _cutHashes) @@ -93,3 +135,100 @@ cutToCutHashes p c = CutHashes , _cutHashesChainwebVersion = _chainwebVersion c } +-- -------------------------------------------------------------------------- -- +-- CutId + +type CutIdBytesCount = 32 + +cutIdBytesCount :: Natural +cutIdBytesCount = natVal $ Proxy @CutIdBytesCount +{-# INLINE cutIdBytesCount #-} + +-- | This is used to uniquly identify a cut. +-- +newtype CutId = CutId SB.ShortByteString + deriving (Show, Eq, Ord, Generic) + deriving anyclass (NFData) + +encodeCutId :: MonadPut m => CutId -> m () +encodeCutId (CutId w) = putByteString $ SB.fromShort w +{-# INLINE encodeCutId #-} + +cutIdBytes :: CutId -> SB.ShortByteString +cutIdBytes (CutId bytes) = bytes +{-# INLINE cutIdBytes #-} + +decodeCutId :: MonadGet m => m CutId +decodeCutId = CutId . SB.toShort <$> getBytes (int cutIdBytesCount) +{-# INLINE decodeCutId #-} + +instance Hashable CutId where + hashWithSalt s (CutId bytes) = xor s + . unsafePerformIO + $ BA.withByteArray (SB.fromShort bytes) (peek @Int) + -- CutIds are already cryptographically strong hashes + -- that include the chain id. + {-# INLINE hashWithSalt #-} + +instance ToJSON CutId where + toJSON = toJSON . toText + {-# INLINE toJSON #-} + +instance FromJSON CutId where + parseJSON = parseJsonFromText "CutId" + {-# INLINE parseJSON #-} + +cutIdToText :: CutId -> T.Text +cutIdToText = encodeB64UrlNoPaddingText . runPutS . encodeCutId +{-# INLINE cutIdToText #-} + +cutIdFromText :: MonadThrow m => T.Text -> m CutId +cutIdFromText t = either (throwM . TextFormatException . sshow) return + $ runGet decodeCutId =<< decodeB64UrlNoPaddingText t +{-# INLINE cutIdFromText #-} + +instance HasTextRepresentation CutId where + toText = cutIdToText + {-# INLINE toText #-} + fromText = cutIdFromText + {-# INLINE fromText #-} + +cutIdToTextShort :: CutId -> T.Text +cutIdToTextShort = T.take 6 . toText + +-- -------------------------------------------------------------------------- -- +-- HasCutId Class + +class HasCutId c where + _cutId :: c -> CutId + cutId :: Getter c CutId + + cutId = to _cutId + _cutId = view cutId + {-# INLINE cutId #-} + {-# INLINE _cutId #-} + + {-# MINIMAL cutId | _cutId #-} + +instance HasCutId CutHashes where + _cutId = _cutId . fmap snd . _cutHashes + {-# INLINE _cutId #-} + +instance HasCutId Cut where + _cutId = _cutId . cutToCutHashes Nothing + {-# INLINE _cutId #-} + +instance HasCutId (HM.HashMap x BlockHash) where + _cutId = CutId + . SB.toShort + . BA.convert + . C.hash @_ @SHA512t_256 + . mconcat + . fmap (runPut . encodeBlockHash) + . toList + {-# INLINE _cutId #-} + +instance HasCutId (HM.HashMap x BlockHeader) where + _cutId = _cutId . fmap _blockHash + {-# INLINE _cutId #-} + diff --git a/src/Chainweb/Cut/Test.hs b/src/Chainweb/Cut/Test.hs new file mode 100644 index 0000000000..fa46742966 --- /dev/null +++ b/src/Chainweb/Cut/Test.hs @@ -0,0 +1,621 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE UndecidableInstances #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +-- | +-- Module: Chainweb.Cut.Test +-- Copyright: Copyright © 2019 Kadena LLC. +-- License: MIT +-- Maintainer: Lars Kuhtz +-- Stability: experimental +-- +-- TODO +-- +module Chainweb.Cut.Test +( +-- * Testing + + MineFailure(..) +, testMine +, testMineWithPayload +, createNewCut +, randomChainId +, arbitraryChainGraphChainId +, giveNewWebChain + +-- ** properties +, prop_cutBraiding +, prop_cutBraidingGenesis +, prop_joinBase +, prop_joinBaseMeet + +, properties_lattice +, properties_lattice_passing +, properties_cut +, properties_testMining + +-- ** all passing properties +, properties + +) where + +import Control.Error.Util (hush, note) +import Control.Exception hiding (catch) +import Control.Lens hiding ((:>)) +import Control.Monad hiding (join) +import Control.Monad.IO.Class + +import Data.Bifunctor (first) +import Data.Foldable +import Data.Function +import qualified Data.HashMap.Strict as HM +import Data.Int (Int64) +import Data.Monoid +import Data.Ord +import Data.Reflection hiding (int) +import Data.Tuple.Strict (T2(..)) + +import GHC.Generics (Generic) +import GHC.Stack + +import Prelude hiding (lookup) + +import qualified QuickCheck.GenT as TT + +import qualified Streaming.Prelude as S + +import qualified Test.QuickCheck as T +import qualified Test.QuickCheck.Monadic as T + +-- internal modules + +import Chainweb.BlockHash +import Chainweb.BlockHeader +import Chainweb.BlockHeader.Genesis (genesisBlockTarget) +import Chainweb.ChainId +import Chainweb.Cut +import Chainweb.Difficulty (HashTarget, checkTarget) +import Chainweb.Graph +import Chainweb.NodeId +import Chainweb.Payload +import Chainweb.Payload.PayloadStore +import Chainweb.Time (Time, getCurrentTimeIntegral, second) +import Chainweb.Utils +import Chainweb.Version +import Chainweb.WebBlockHeaderDB +import Chainweb.WebPactExecutionService + +import Numeric.AffineSpace + +-- -------------------------------------------------------------------------- -- +-- Test Mining + +data MineFailure = BadNonce | BadAdjacents + +-- Try to mine a new block header on the given chain for the given cut. +-- Returns 'Nothing' if mining isn't possible because of missing adjacent +-- dependencies. +-- +testMine + :: forall cid + . HasChainId cid + => Given WebBlockHeaderDb + => Nonce + -> HashTarget + -> Time Int64 + -> BlockPayloadHash + -> NodeId + -> cid + -> Cut + -> IO (Either MineFailure (T2 BlockHeader Cut)) +testMine n target t payloadHash nid i c = + forM (createNewCut n target t payloadHash nid i c) $ \p@(T2 h _) -> + p <$ insertWebBlockHeaderDb h + +testMineWithPayload + :: forall cas cid + . HasChainId cid + => PayloadCas cas + => Given WebBlockHeaderDb + => Given (PayloadDb cas) + => Nonce + -> HashTarget + -> Time Int64 + -> PayloadWithOutputs + -> NodeId + -> cid + -> Cut + -> PactExecutionService + -> IO (Either MineFailure (T2 BlockHeader Cut)) +testMineWithPayload n target t payload nid i c pact = + forM (createNewCut n target t payloadHash nid i c) $ \p@(T2 h _) -> do + validatePayload h payload + addNewPayload (given @(PayloadDb cas)) payload + insertWebBlockHeaderDb h + return p + where + payloadHash = _payloadWithOutputsPayloadHash payload + + validatePayload :: BlockHeader -> PayloadWithOutputs -> IO () + validatePayload h o = void $ _pactValidateBlock pact h $ toPayloadData o + + toPayloadData p = PayloadData + { _payloadDataTransactions = fst <$> _payloadWithOutputsTransactions p + , _payloadDataMiner = _payloadWithOutputsMiner p + , _payloadDataPayloadHash = _payloadWithOutputsPayloadHash p + , _payloadDataTransactionsHash = _payloadWithOutputsTransactionsHash p + , _payloadDataOutputsHash = _payloadWithOutputsOutputsHash p + } + +-- | Create a new block. Only produces a new cut but doesn't insert it into the +-- chain database. +-- +createNewCut + :: HasCallStack + => HasChainId cid + => Nonce + -> HashTarget + -> Time Int64 + -> BlockPayloadHash + -> NodeId + -> cid + -> Cut + -> Either MineFailure (T2 BlockHeader Cut) +createNewCut n target t pay nid i c = do + h <- note BadAdjacents $ newHeader . BlockHashRecord <$> newAdjHashes + unless (checkTarget target $ _blockPow h) $ Left BadNonce + c' <- first (\e -> error $ "Chainweb.Cut.createNewCut: " <> sshow e) + $ monotonicCutExtension c h + return $ T2 h c' + where + cid = _chainId i + + -- | The parent block to mine on. + -- + p :: BlockHeader + p = c ^?! ixg cid + + newHeader :: BlockHashRecord -> BlockHeader + newHeader as = newBlockHeader (nodeIdFromNodeId nid cid) as pay n target t p + + -- | Try to get all adjacent hashes dependencies. + -- + newAdjHashes :: Maybe (HM.HashMap ChainId BlockHash) + newAdjHashes = iforM (_getBlockHashRecord $ _blockAdjacentHashes p) $ \xcid _ -> + c ^?! ixg xcid . to (tryAdj (_blockHeight p)) + + tryAdj :: BlockHeight -> BlockHeader -> Maybe BlockHash + tryAdj h b + | _blockHeight b == h = Just $! _blockHash b + | _blockHeight b == h + 1 = Just $! _blockParent b + | otherwise = Nothing + +-- | Create a new cut where the new block has a creation time of one second +-- after its parent. +-- +createNewCutWithoutTime + :: HasCallStack + => HasChainId cid + => Nonce + -> HashTarget + -> BlockPayloadHash + -> NodeId + -> cid + -> Cut + -> Maybe (T2 BlockHeader Cut) +createNewCutWithoutTime n target pay nid i c + = hush $ createNewCut n target (add second t) pay nid i c + where + cid = _chainId i + BlockCreationTime t = _blockCreationTime $ c ^?! ixg cid + + +-- -------------------------------------------------------------------------- -- +-- Arbitrary Cuts + +arbitraryCut + :: HasCallStack + => ChainwebVersion + -> T.Gen Cut +arbitraryCut v = T.sized $ \s -> do + k <- T.choose (0,s) + foldlM (\c _ -> genCut c) (genesisCut v) [0..(k-1)] + where + genCut :: Cut -> T.Gen Cut + genCut c = do + cids <- T.shuffle (toList $ chainIds v) + S.each cids + & S.mapMaybeM (mine c) + & S.map (\(T2 _ x) -> x) + & S.head_ + & fmap fromJuste + + mine :: Cut -> ChainId -> T.Gen (Maybe (T2 BlockHeader Cut)) + mine c cid = do + n <- Nonce <$> T.arbitrary + nid <- T.arbitrary + let pay = hashPayload v cid "TEST PAYLOAD" + return $ createNewCutWithoutTime n target pay nid cid c + + target = genesisBlockTarget v + +arbitraryChainGraphChainId :: Given ChainGraph => T.Gen ChainId +arbitraryChainGraphChainId = T.elements (toList $ graphChainIds given) + +instance Given ChainwebVersion => T.Arbitrary Cut where + arbitrary = arbitraryCut given + +-- | Provide option to provide db with a branch/cut. +-- +arbitraryWebChainCut + :: HasCallStack + => Given WebBlockHeaderDb + => Cut + -- @genesisCut Test@ is always a valid cut + -> T.PropertyM IO Cut +arbitraryWebChainCut initialCut = do + k <- T.pick $ T.sized $ \s -> T.choose (0,s) + foldlM (\c _ -> genCut c) initialCut [0..(k-1)] + where + genCut c = do + cids <- T.pick + $ T.shuffle + $ toList + $ chainIds initialCut + S.each cids + & S.mapMaybeM (mine c) + & S.map (\(T2 _ c') -> c') + & S.head_ + & fmap fromJuste + + mine c cid = do + n <- T.pick $ Nonce <$> T.arbitrary + nid <- T.pick T.arbitrary + t <- liftIO getCurrentTimeIntegral + let pay = hashPayload v cid "TEST PAYLOAD" + liftIO $ hush <$> testMine n target t pay nid cid c + + target = genesisBlockTarget v + v = Test (_chainGraph @WebBlockHeaderDb given) + +arbitraryWebChainCut_ + :: HasCallStack + => Given WebBlockHeaderDb + => Cut + -- @genesisCut Test@ is always a valid cut + -> TT.GenT IO Cut +arbitraryWebChainCut_ initialCut = do + k <- TT.sized $ \s -> TT.choose (0,s) + foldlM (\c _ -> genCut c) initialCut [0..(k-1)] + where + genCut c = do + cids <- TT.liftGen + $ T.shuffle + $ toList + $ chainIds initialCut + S.each cids + & S.mapMaybeM (fmap hush . mine c) + & S.map (\(T2 _ c') -> c') + & S.head_ + & fmap fromJuste + + mine c cid = do + n <- Nonce <$> TT.liftGen T.arbitrary + nid <- TT.liftGen T.arbitrary + t <- liftIO getCurrentTimeIntegral + let pay = hashPayload v cid "TEST PAYLOAD" + liftIO $ testMine n target t pay nid cid c + + target = genesisBlockTarget v + v = Test $ _chainGraph @WebBlockHeaderDb given + +-- -------------------------------------------------------------------------- -- +-- Arbitrary Fork + +testGenCut :: Given WebBlockHeaderDb => Cut +testGenCut = genesisCut $ Test $ _chainGraph @WebBlockHeaderDb given + +data TestFork = TestFork + { _testForkBase :: !Cut + , _testForkLeft :: !Cut + , _testForkRight :: !Cut + } + deriving (Show, Eq, Ord, Generic) + +instance (Given WebBlockHeaderDb) => T.Arbitrary (IO TestFork) where + arbitrary = TT.runGenT arbitraryFork_ + +instance (Given WebBlockHeaderDb) => T.Arbitrary (IO (Join Int)) where + arbitrary = TT.runGenT $ do + TestFork _ cl cr <- arbitraryFork_ + liftIO $ join given (prioritizeHeavier cl cr) cl cr + +-- | Fork point is the genesis cut +-- +-- TODO: provide option to fork of elsewhere +-- +arbitraryFork + :: Given WebBlockHeaderDb + => T.PropertyM IO TestFork +arbitraryFork = do + base <- arbitraryWebChainCut testGenCut + TestFork base + <$> arbitraryWebChainCut base + <*> arbitraryWebChainCut base + +arbitraryFork_ + :: Given WebBlockHeaderDb + => TT.GenT IO TestFork +arbitraryFork_ = do + base <- arbitraryWebChainCut_ testGenCut + TestFork base + <$> arbitraryWebChainCut_ base + <*> arbitraryWebChainCut_ base + +-- -------------------------------------------------------------------------- -- +-- 'meet' and 'join' form a lattice with genesisCut as bottom +-- +-- The order of the lattice is conistent with the weight order. +-- +-- Note: +-- +-- * The non-optimal join function 'joinIntoHeavier' doesn't satisfy the lattice +-- laws In particular associativity. However it must satisfy commutativity, +-- for reasonably fast convergence. +-- +-- * 'joinIntoHeavier' is likely to be optimal on low diameter graphs even for +-- relatively small test instance size parameters, because it is optimal when +-- a fork on a chain is longer than the diameter.) +-- +-- * for fork of depth 1 'joinIntoHeavier' is not a good strategy. +-- +-- * TODO: properties about consistency of order +-- + +-- Join + +prop_joinIdempotent + :: Given WebBlockHeaderDb + => T.PropertyM IO Bool +prop_joinIdempotent = do + c <- arbitraryWebChainCut testGenCut + T.run $ (==) c <$> joinIntoHeavier given c c + +-- FIXME! +prop_joinCommutative + :: Given WebBlockHeaderDb + => T.PropertyM IO Bool +prop_joinCommutative = do + TestFork _ cl cr <- arbitraryFork + T.run $ (==) + <$> joinIntoHeavier given cl cr + <*> joinIntoHeavier given cr cl + +-- Fails for heuristic joins +-- +prop_joinAssociative + :: Given WebBlockHeaderDb + => T.PropertyM IO Bool +prop_joinAssociative = do + TestFork _ c0 c1 <- arbitraryFork + TestFork _ c10 c11 <- TestFork c1 + <$> arbitraryWebChainCut c1 + <*> arbitraryWebChainCut c1 + + -- d0 <- T.run $ forkDepth c10 c11 + -- T.pre (diameter (given @ChainGraph) <= d0) + -- T.monitor (T.counterexample $ "fork depth: " <> sshow d0) + -- d1 <- T.run $ forkDepth c0 c10 + -- T.pre (diameter (given @ChainGraph) <= d1) + -- T.monitor (T.counterexample $ "fork depth: " <> sshow d1) + + T.run $ do + let m = joinIntoHeavier given + (==) + <$> (m c0 =<< m c10 c11) + <*> (m c0 c10 >>= \x -> m x c11) + +prop_joinIdentity + :: Given WebBlockHeaderDb + => T.PropertyM IO Bool +prop_joinIdentity = do + c <- arbitraryWebChainCut testGenCut + T.run $ (==) c <$> joinIntoHeavier given testGenCut c + +-- Meet + +prop_meetIdempotent + :: Given WebBlockHeaderDb + => T.PropertyM IO Bool +prop_meetIdempotent = do + c <- arbitraryWebChainCut testGenCut + T.run $ (==) c <$> meet given c c + +prop_meetCommutative + :: Given WebBlockHeaderDb + => T.PropertyM IO Bool +prop_meetCommutative = do + TestFork _ cl cr <- arbitraryFork + T.run $ (==) + <$> meet given cl cr + <*> meet given cr cl + +prop_meetAssociative + :: Given WebBlockHeaderDb + => T.PropertyM IO Bool +prop_meetAssociative = do + TestFork _ c0 c1 <- arbitraryFork + TestFork _ c10 c11 <- TestFork c1 + <$> arbitraryWebChainCut c1 + <*> arbitraryWebChainCut c1 + T.run $ do + let m = meet given + (==) + <$> (m c0 =<< m c10 c11) + <*> (m c0 c10 >>= \x -> m x c11) + +-- | this a corollary of 'prop_joinIdentity' and 'prop_meetJoinAbsorption' +-- +prop_meetZeroAbsorption + :: Given WebBlockHeaderDb + => T.PropertyM IO Bool +prop_meetZeroAbsorption = do + c <- arbitraryWebChainCut testGenCut + T.run $ do + c' <- meet given testGenCut c + return (c == c') + +prop_joinMeetAbsorption + :: Given WebBlockHeaderDb + => T.PropertyM IO Bool +prop_joinMeetAbsorption = do + TestFork _ c0 c1 <- arbitraryFork + T.run $ do + c0' <- joinIntoHeavier given c0 =<< meet given c0 c1 + return (c0' == c0) + +prop_meetJoinAbsorption + :: Given WebBlockHeaderDb + => T.PropertyM IO Bool +prop_meetJoinAbsorption = do + TestFork _ c0 c1 <- arbitraryFork + T.run $ do + c0' <- meet given c0 =<< joinIntoHeavier given c0 c1 + return (c0' == c0) + +properties_lattice :: ChainwebVersion -> [(String, T.Property)] +properties_lattice v = + [ ("joinIdemPotent", ioTest v prop_joinIdempotent) + , ("joinCommutative", ioTest v prop_joinCommutative) + , ("joinAssociative", ioTest v prop_joinAssociative) -- Fails + , ("joinIdentity", ioTest v prop_joinIdentity) + + , ("meetIdemPotent", ioTest v prop_meetIdempotent) + , ("meetCommutative", ioTest v prop_meetCommutative) + , ("meetAssociative", ioTest v prop_meetAssociative) + , ("meetZeroAbsorption", ioTest v prop_meetZeroAbsorption) -- Fails + + , ("joinMeetAbsorption", ioTest v prop_joinMeetAbsorption) + , ("meetJoinAbsorption", ioTest v prop_meetJoinAbsorption) -- Fails + ] + +properties_lattice_passing :: ChainwebVersion -> [(String, T.Property)] +properties_lattice_passing v = + [ ("joinIdemPotent", ioTest v prop_joinIdempotent) + , ("joinCommutative", ioTest v prop_joinCommutative) + , ("joinIdentity", ioTest v prop_joinIdentity) + + , ("meetIdemPotent", ioTest v prop_meetIdempotent) + , ("meetCommutative", ioTest v prop_meetCommutative) + , ("meetAssociative", ioTest v prop_meetAssociative) + + , ("joinMeetAbsorption", ioTest v prop_joinMeetAbsorption) + ] + +-- -------------------------------------------------------------------------- -- +-- Cut Properties + +prop_cutBraiding :: Cut -> Bool +prop_cutBraiding = either throw (const True) . checkBraidingOfCut + +prop_cutBraidingGenesis :: ChainwebVersion -> Bool +prop_cutBraidingGenesis v = either throw (const True) + $ checkBraidingOfCut (genesisCut v) + +-- TODO +-- +-- * cuts are partially ordered with respect to parent and parent hashes +-- * partial order is consistent with weight and blockheight +-- +-- * this order induces a lattice + +properties_cut :: ChainwebVersion -> [(String, T.Property)] +properties_cut v = + [ ("Cut has valid braiding", give v $ T.property prop_cutBraiding) + , ("Genesis Cut has valid braiding", T.property (prop_cutBraidingGenesis v)) + ] + +-- -------------------------------------------------------------------------- -- +-- Meet Properties + +prop_meetGenesisCut :: Given WebBlockHeaderDb => T.PropertyM IO Bool +prop_meetGenesisCut = liftIO $ (==) c <$> meet given c c + where + c = testGenCut + +-- -------------------------------------------------------------------------- -- +-- Misc Properties + +prop_arbitraryForkBraiding :: ChainwebVersion -> T.Property +prop_arbitraryForkBraiding v = ioTest v $ give (_chainGraph v) $ do + TestFork b cl cr <- arbitraryFork + T.assert (prop_cutBraiding b) + T.assert (prop_cutBraiding cl) + T.assert (prop_cutBraiding cr) + return True + +prop_joinBase :: ChainwebVersion -> T.Property +prop_joinBase v = ioTest v $ do + TestFork b cl cr <- arbitraryFork + m <- liftIO $ join given (prioritizeHeavier cl cr) cl cr + return (_joinBase m == b) + +prop_joinBaseMeet :: ChainwebVersion -> T.Property +prop_joinBaseMeet v = ioTest v $ do + TestFork _ a b <- arbitraryFork + liftIO $ (==) + <$> meet given a b + <*> (_joinBase <$> join given (prioritizeHeavier a b) a b) + +properties_testMining :: ChainwebVersion -> [(String, T.Property)] +properties_testMining v = + [ ("Cuts of arbitrary fork have valid braiding", prop_arbitraryForkBraiding v)] + +properties_misc :: ChainwebVersion -> [(String, T.Property)] +properties_misc v = + [ ("prop_joinBase", prop_joinBase v) + , ("prop_joinBaseMeet", prop_joinBaseMeet v) + , ("prop_meetGenesisCut", ioTest v prop_meetGenesisCut) + , ("Cuts of arbitrary fork have valid braiding", prop_arbitraryForkBraiding v) + ] + +-- -------------------------------------------------------------------------- -- +-- "Valid" Properties + +properties :: [(String, T.Property)] +properties + = properties_lattice_passing v + <> properties_cut v + <> properties_testMining v + <> properties_misc v + where + v = Test pairChainGraph + +-- -------------------------------------------------------------------------- -- +-- TestTools + +giveNewWebChain + :: MonadIO m + => ChainwebVersion + -> (Given WebBlockHeaderDb => m a) + -> m a +giveNewWebChain v f = do + db <- liftIO (initWebBlockHeaderDb v) + give db f + +ioTest + :: ChainwebVersion + -> (Given WebBlockHeaderDb => T.PropertyM IO Bool) + -> T.Property +ioTest v f = T.monadicIO $ giveNewWebChain v $ f >>= T.assert diff --git a/src/Chainweb/CutDB.hs b/src/Chainweb/CutDB.hs index 413c9e6fb3..371c647527 100644 --- a/src/Chainweb/CutDB.hs +++ b/src/Chainweb/CutDB.hs @@ -78,7 +78,6 @@ import Data.LogMessage import Data.Maybe import Data.Monoid import Data.Ord -import Data.Reflection hiding (int) import qualified Data.Text as T import GHC.Generics hiding (to) @@ -131,13 +130,13 @@ defaultCutDbConfig :: ChainwebVersion -> CutDbConfig defaultCutDbConfig v = CutDbConfig { _cutDbConfigInitialCut = genesisCut v , _cutDbConfigInitialCutFile = Nothing - , _cutDbConfigBufferSize = 20 - -- FIXME this should probably depend on the diameter of the graph - -- It shouldn't be too big. + , _cutDbConfigBufferSize = (order g ^ (2 :: Int)) * diameter g , _cutDbConfigLogLevel = Warn , _cutDbConfigTelemetryLevel = Warn , _cutDbConfigUseOrigin = True } + where + g = _chainGraph v -- -------------------------------------------------------------------------- -- -- Cut DB @@ -151,6 +150,7 @@ data CutDb cas = CutDb , _cutDbLogFunction :: !LogFunction , _cutDbHeaderStore :: !WebBlockHeaderStore , _cutDbPayloadStore :: !(WebBlockPayloadStore cas) + , _cutDbQueueSize :: !Natural } instance HasChainGraph (CutDb cas) where @@ -190,7 +190,7 @@ cut :: Getter (CutDb cas) (IO Cut) cut = to _cut addCutHashes :: CutDb cas -> CutHashes -> IO () -addCutHashes db = pQueueInsert (_cutDbQueue db) . Down +addCutHashes db = pQueueInsertLimit (_cutDbQueue db) (_cutDbQueueSize db) . Down -- | An 'STM' version of '_cut'. -- @@ -240,11 +240,18 @@ startCutDb -> IO (CutDb cas) startCutDb config logfun headerStore payloadStore = mask_ $ do cutVar <- newTVarIO (_cutDbConfigInitialCut config) - -- queue <- newEmptyPQueue (int $ _cutDbConfigBufferSize config) queue <- newEmptyPQueue cutAsync <- asyncWithUnmask $ \u -> u $ processor queue cutVar logfun @T.Text Info "CutDB started" - return $ CutDb cutVar queue cutAsync logfun headerStore payloadStore + return $ CutDb + { _cutDbCut = cutVar + , _cutDbQueue = queue + , _cutDbAsync = cutAsync + , _cutDbLogFunction = logfun + , _cutDbHeaderStore = headerStore + , _cutDbPayloadStore = payloadStore + , _cutDbQueueSize = _cutDbConfigBufferSize config + } where processor :: PQueue (Down CutHashes) -> TVar Cut -> IO () processor queue cutVar = do @@ -274,42 +281,57 @@ processCuts -> TVar Cut -> IO () processCuts logFun headerStore payloadStore queue cutVar = queueToStream + & S.chain (\c -> loggc Info c $ "start processing") & S.filterM (fmap not . isVeryOld) & S.filterM (fmap not . isOld) & S.filterM (fmap not . isCurrent) + & S.chain (\c -> loggc Info c $ "fetch all prerequesites") & S.mapM (cutHashesToBlockHeaderMap headerStore payloadStore) + & S.chain (either + (\c -> loggc Warn c "failed to get prerequesites for some blocks") + (\c -> loggc Info c "got all prerequesites") + ) & S.concat -- ignore left values for now & S.scanM - (\a b -> give (_webBlockHeaderStoreCas headerStore) $ joinIntoHeavier_ (_cutMap a) b) + (\a b -> joinIntoHeavier_ (_webBlockHeaderStoreCas headerStore) (_cutMap a) b + ) (readTVarIO cutVar) - (\c -> atomically (writeTVar cutVar c) >> logFun @T.Text Debug "write new cut") + (\c -> do + atomically (writeTVar cutVar c) + loggc Info c "published cut" + ) & S.effects where + loggc :: HasCutId c => LogLevel -> c -> T.Text -> IO () + loggc l c msg = logFun @T.Text l $ "cut " <> cutIdToTextShort (_cutId c) <> ": " <> msg + graph = _chainGraph headerStore threshold :: Int - threshold = int $ 2 * diameter graph* order graph + threshold = int $ 2 * diameter graph * order graph - queueToStream = - liftIO (pQueueRemove queue) >>= \(Down a) -> S.yield a >> queueToStream + queueToStream = do + Down a <- liftIO (pQueueRemove queue) + S.yield a + queueToStream isVeryOld x = do h <- _cutHeight <$> readTVarIO cutVar let r = int (_cutHashesHeight x) <= (int h - threshold) - when r $ logFun @T.Text Debug "skip very old cut" + when r $ loggc Info x "skip very old cut" return r isOld x = do curHashes <- cutToCutHashes Nothing <$> readTVarIO cutVar let r = all (>= (0 :: Int)) $ (HM.unionWith (-) `on` (fmap (int . fst) . _cutHashes)) curHashes x - when r $ logFun @T.Text Debug "skip old cut" + when r $ loggc Info x "skip old cut" return r isCurrent x = do curHashes <- cutToCutHashes Nothing <$> readTVarIO cutVar let r = _cutHashes curHashes == _cutHashes x - when r $ logFun @T.Text Debug "skip current cut" + when r $ loggc Info x "skip current cut" return r -- | Stream of most recent cuts. This stream does not generally include the full diff --git a/src/Chainweb/CutDB/RestAPI.hs b/src/Chainweb/CutDB/RestAPI.hs index 729329e732..f8601ae853 100644 --- a/src/Chainweb/CutDB/RestAPI.hs +++ b/src/Chainweb/CutDB/RestAPI.hs @@ -38,6 +38,7 @@ import Chainweb.Cut.CutHashes import Chainweb.RestAPI.NetworkID import Chainweb.RestAPI.Orphans () import Chainweb.RestAPI.Utils +import Chainweb.TreeDB (MaxRank(..)) import Chainweb.Version import Data.Singletons @@ -47,6 +48,7 @@ import Data.Singletons type CutGetApi_ = "cut" + :> QueryParam "maxheight" MaxRank :> Get '[JSON] CutHashes type CutGetApi (v :: ChainwebVersionT) diff --git a/src/Chainweb/CutDB/RestAPI/Client.hs b/src/Chainweb/CutDB/RestAPI/Client.hs index 981279aff7..b878457673 100644 --- a/src/Chainweb/CutDB/RestAPI/Client.hs +++ b/src/Chainweb/CutDB/RestAPI/Client.hs @@ -12,6 +12,7 @@ -- module Chainweb.CutDB.RestAPI.Client ( cutGetClient +, cutGetClientLimit , cutPutClient ) where @@ -23,6 +24,7 @@ import Servant.Client import Chainweb.ChainId import Chainweb.Cut.CutHashes import Chainweb.CutDB.RestAPI +import Chainweb.TreeDB (MaxRank(..)) import Chainweb.Version import Data.Singletons @@ -33,7 +35,15 @@ import Data.Singletons cutGetClient :: ChainwebVersion -> ClientM CutHashes -cutGetClient (FromSing (SChainwebVersion :: Sing v)) = client $ cutGetApi @v +cutGetClient (FromSing (SChainwebVersion :: Sing v)) + = client (cutGetApi @v) Nothing + +cutGetClientLimit + :: ChainwebVersion + -> MaxRank + -> ClientM CutHashes +cutGetClientLimit (FromSing (SChainwebVersion :: Sing v)) + = client (cutGetApi @v) . Just -- -------------------------------------------------------------------------- -- -- PUT Cut Client diff --git a/src/Chainweb/CutDB/RestAPI/Server.hs b/src/Chainweb/CutDB/RestAPI/Server.hs index d016f2a1aa..c1e93f48dd 100644 --- a/src/Chainweb/CutDB/RestAPI/Server.hs +++ b/src/Chainweb/CutDB/RestAPI/Server.hs @@ -30,9 +30,11 @@ module Chainweb.CutDB.RestAPI.Server , serveCutOnPort ) where +import Control.Lens (view) import Control.Monad.Except import Data.Proxy +import Data.Semigroup import Network.Wai.Handler.Warp hiding (Port) @@ -41,21 +43,25 @@ import Servant.Server -- internal modules +import Chainweb.Cut import Chainweb.Cut.CutHashes import Chainweb.CutDB import Chainweb.CutDB.RestAPI import Chainweb.HostAddress import Chainweb.RestAPI.Utils +import Chainweb.TreeDB (MaxRank(..)) import Chainweb.Utils import Chainweb.Version -- -------------------------------------------------------------------------- -- -- Handlers --- | FIXME: include own peer info --- -cutGetHandler :: CutDb cas -> Handler CutHashes -cutGetHandler db = liftIO $ cutToCutHashes Nothing <$> _cut db +cutGetHandler :: CutDb cas -> Maybe MaxRank -> Handler CutHashes +cutGetHandler db Nothing = liftIO $ cutToCutHashes Nothing <$> _cut db +cutGetHandler db (Just (MaxRank (Max mar))) = liftIO $ do + c <- _cut db + c' <- limitCut (view cutDbWebBlockHeaderDb db) (int mar) c + return $ cutToCutHashes Nothing c' cutPutHandler :: CutDb cas -> CutHashes -> Handler NoContent cutPutHandler db c = NoContent <$ liftIO (addCutHashes db c) diff --git a/src/Chainweb/Difficulty.hs b/src/Chainweb/Difficulty.hs index 816239ac22..b3c52f1365 100644 --- a/src/Chainweb/Difficulty.hs +++ b/src/Chainweb/Difficulty.hs @@ -62,8 +62,8 @@ module Chainweb.Difficulty , blockRate , WindowWidth(..) , window -, MaxAdjustment(..) -, maxAdjust +, MinAdjustment(..) +, minAdjust , prereduction -- ** Adjustment , adjust @@ -314,9 +314,10 @@ blockRate :: ChainwebVersion -> Maybe BlockRate blockRate Test{} = Nothing blockRate TestWithTime{} = Just $ BlockRate 4 blockRate TestWithPow{} = Just $ BlockRate 10 -blockRate Simulation{} = Nothing -- 120 blocks per hour, 2,880 per day, 20,160 per week, 1,048,320 per year. blockRate Testnet00 = Just $ BlockRate 30 +-- 120 blocks per hour, 2,880 per day, 20,160 per week, 1,048,320 per year. +blockRate Testnet01 = Just $ BlockRate 30 -- | The number of blocks to be mined after a difficulty adjustment, before -- considering a further adjustment. Critical for the "epoch-based" adjustment @@ -332,26 +333,27 @@ window Test{} = Nothing window TestWithTime{} = Nothing -- 5 blocks, should take 50 seconds. window TestWithPow{} = Just $ WindowWidth 5 -window Simulation{} = Nothing -- 120 blocks, should take 1 hour given a 30 second BlockRate. window Testnet00 = Just $ WindowWidth 120 +-- 120 blocks, should take 1 hour given a 30 second BlockRate. +window Testnet01 = Just $ WindowWidth 120 --- | The maximum number of bits that a single application of `adjust` can apply --- to some `HashTarget`. As mentioned in `adjust`, this value should be above --- \(e = 2.71828\cdots\). +-- | The minimum factor of change that a single application of `adjust` must +-- apply to some `HashTarget` for it to be accepted. As mentioned in `adjust`, +-- this value should be above \(e = 2.71828\cdots\). -- -newtype MaxAdjustment = MaxAdjustment Natural +newtype MinAdjustment = MinAdjustment Natural --- | The Proof-of-Work `MaxAdjustment` for each `ChainwebVersion`. For chainwebs +-- | The Proof-of-Work `MinAdjustment` for each `ChainwebVersion`. For chainwebs -- that do not expect to perform POW, this should be `Nothing`. -- -maxAdjust :: ChainwebVersion -> Maybe MaxAdjustment -maxAdjust Test{} = Nothing -maxAdjust TestWithTime{} = Nothing -maxAdjust TestWithPow{} = Just $ MaxAdjustment 3 -maxAdjust Simulation{} = Nothing +minAdjust :: ChainwebVersion -> Maybe MinAdjustment +minAdjust Test{} = Nothing +minAdjust TestWithTime{} = Nothing +minAdjust TestWithPow{} = Just $ MinAdjustment 3 -- See `adjust` for motivation. -maxAdjust Testnet00 = Just $ MaxAdjustment 3 +minAdjust Testnet00 = Just $ MinAdjustment 3 +minAdjust Testnet01 = Just $ MinAdjustment 3 -- | The number of bits to offset `maxTarget` by from `maxBound`, so as to -- enforce a "minimum difficulty", beyond which mining cannot become easier. @@ -362,7 +364,6 @@ prereduction :: ChainwebVersion -> Int prereduction Test{} = 0 prereduction TestWithTime{} = 0 prereduction TestWithPow{} = 7 -prereduction Simulation{} = 0 -- As alluded to in `maxTarget`, 11 bits has been shown experimentally to be -- high enough to keep mining slow during the initial conditions of a -- single-machine-10-chain-10-miner scenario, thereby avoiding (too many) @@ -372,6 +373,7 @@ prereduction Simulation{} = 0 -- wildly imbalanced over the first few days. Subsequent Difficulty Adjustment -- compensates for any remaining imbalance. prereduction Testnet00 = 14 +prereduction Testnet01 = 14 -- | A new `HashTarget`, based on the rate of mining success over the previous N -- blocks. @@ -480,29 +482,32 @@ prereduction Testnet00 = 14 -- expectations. For now, however, `Rational` is stable for a Haskell-only -- environment. -- --- === Adjustment Limits +-- === Adjustment Minimums -- --- Spikes in /HashRate/ may occur as the mining network grows. To ensure that --- adjustment does not occur too quickly, we cap the total "significant bits of --- change" as to no more than \(Z\) bits in either the "harder" or "easier" --- direction at one time. Experimentally, it has been shown that \(Z\) should be --- greater than \(e = 2.71828\cdots\) (/source needed/). See `maxAdjust`. +-- Spikes in /HashRate/ may occur as the mining network grows and shrinks. To +-- ensure that adjustment does not occur too quickly or with too much +-- granularity, we enforce a "minimum factor of change" ( \(Z\) ) for `adjust`. +-- If `adjust` notices that the change for the given window is not large enough, +-- then it will not occur. The overall pattern of difficulty then becomes less +-- of a rippling pond, and more of a series of plateaus with distinct jumps. +-- Analysis has been shown that \(Z\) should be greater than a factor of +-- \(e = 2.71828\cdots\) (/source needed/). See also `minAdjust`. -- adjust :: ChainwebVersion -> TimeSpan Int64 -> HashTarget -> HashTarget adjust ver (TimeSpan delta) oldTarget -- Intent: When increasing the difficulty (thereby lowering the target - -- toward 0), the leading 1-bit must not move more than 3 bits at a time. - | newTarget < oldTarget = max newTarget (HashTarget $! oldNat `div` 8) - -- Intent: Cap the new target back down, if it somehow managed to go over - -- the maximum. This is possible during POW, since we assume - -- @maxTarget < maxBound@. - | newTarget > maxTarget ver = maxTarget ver + -- toward 0), the target must decrease by at least some minimum threshold + -- (usually 3x) to be accepted. + | nat newTarget <= (nat oldTarget `div` minAdj) = newTarget + -- Intent: When decreasing the difficulty (thereby raising the target toward - -- `maxTarget`), ensure that the new target does not increase by more than 3 - -- bits at a time. Using `countLeadingZeros` like this also helps avoid a - -- `Word256` overflow. - | countLeadingZeros oldNat - countLeadingZeros (nat newTarget) > maxAdj = HashTarget $! oldNat * 8 - | otherwise = newTarget + -- `maxTarget`), ensure that the new target increases by at least some + -- minimum threshold. + | nat newTarget >= (nat oldTarget * minAdj) + && nat oldTarget <= (nat (maxTarget ver) `div` minAdj) = newTarget + + -- Intent: The target did not change enough - do not alter it! + | otherwise = oldTarget -- DEBUGGING -- -- Uncomment the following to get a live view of difficulty adjustment. You @@ -532,9 +537,9 @@ adjust ver (TimeSpan delta) oldTarget Just (WindowWidth n) -> n Nothing -> error $ "adjust: Difficulty adjustment attempted on non-POW chainweb: " <> show ver - maxAdj :: Int - maxAdj = case maxAdjust ver of - Just (MaxAdjustment n) -> int n + minAdj :: PowHashNat + minAdj = case minAdjust ver of + Just (MinAdjustment n) -> int n Nothing -> error $ "adjust: Difficulty adjustment attempted on non-POW chainweb: " <> show ver -- The average time in seconds that it took to mine each block in @@ -559,12 +564,6 @@ adjust ver (TimeSpan delta) oldTarget nat :: HashTarget -> PowHashNat nat (HashTarget n) = n - oldNat :: PowHashNat - oldNat = nat oldTarget - - -- floating :: Rational -> Double - -- floating = realToFrac - -- -------------------------------------------------------------------------- -- -- Properties diff --git a/src/Chainweb/Graph.hs b/src/Chainweb/Graph.hs index 760f03d560..3778262349 100644 --- a/src/Chainweb/Graph.hs +++ b/src/Chainweb/Graph.hs @@ -19,6 +19,8 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableSuperClasses #-} +{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} + -- | -- Module: Chainweb.Graph -- Copyright: Copyright © 2018 Kadena LLC. @@ -41,6 +43,7 @@ module Chainweb.Graph -- * Chain Graph , ChainGraph +, chainGraphKnown , toChainGraph , validChainGraph , adjacentChainIds @@ -63,30 +66,34 @@ module Chainweb.Graph -- * Checks with a given chain graph , isWebChain -, chainIds -, chainIds_ +, graphChainIds , checkWebChainId , checkAdjacentChainIds --- * Some Graphs +-- * Specific, Known Graphs +, KnownGraph(..) +, knownGraph , singletonChainGraph , pairChainGraph +, triangleChainGraph , petersonChainGraph +, twentyChainGraph +, hoffmanSingletonGraph + ) where -import Control.Arrow -import Control.DeepSeq -import Control.Lens -import Control.Monad -import Control.Monad.Catch +import Control.Arrow ((&&&)) +import Control.DeepSeq (NFData(..)) +import Control.Lens (Getter, to, view) +import Control.Monad (unless, void) +import Control.Monad.Catch (Exception, MonadThrow(..)) -import Data.Bits -import Data.Function -import Data.Hashable +import Data.Bits (xor) +import Data.Function (on) +import Data.Hashable (Hashable(..)) import qualified Data.HashSet as HS -import Data.Kind -import Data.Reflection hiding (int) +import Data.Kind (Type) import GHC.Generics hiding (to) @@ -94,10 +101,9 @@ import Numeric.Natural -- internal imports -import Chainweb.ChainId +import Chainweb.ChainId (ChainId, HasChainId(..), unsafeChainId) import Chainweb.Utils -import Data.DiGraph hiding (diameter, order, shortestPath, size) import qualified Data.DiGraph as G -- -------------------------------------------------------------------------- -- @@ -130,8 +136,9 @@ instance Exception ChainGraphException -- Chainweb Graph data ChainGraph = ChainGraph - { _chainGraphGraph :: !(DiGraph ChainId) - , _chainGraphShortestPathCache :: {- lazy -} ShortestPathCache ChainId + { _chainGraphGraph :: !(G.DiGraph ChainId) + , _chainGraphKnown :: !KnownGraph + , _chainGraphShortestPathCache :: {- lazy -} G.ShortestPathCache ChainId , _chainGraphHash :: {- lazy -} Int } deriving (Generic) @@ -149,20 +156,25 @@ instance Ord ChainGraph where instance Hashable ChainGraph where hashWithSalt s = xor s . _chainGraphHash +chainGraphKnown :: Getter ChainGraph KnownGraph +chainGraphKnown = to _chainGraphKnown +{-# INLINE chainGraphKnown #-} + -- | This function is unsafe, it throws an error if the graph isn't a valid -- chain graph. That's OK, since chaingraphs are hard-coded in the code and --- won't change dinamically, except for during testing. +-- won't change dynamically, except for during testing. -- -toChainGraph :: (a -> ChainId) -> DiGraph a -> ChainGraph -toChainGraph f g +toChainGraph :: (a -> ChainId) -> KnownGraph -> G.DiGraph a -> ChainGraph +toChainGraph f kg g | validChainGraph c = ChainGraph { _chainGraphGraph = c - , _chainGraphShortestPathCache = shortestPathCache c + , _chainGraphKnown = kg + , _chainGraphShortestPathCache = G.shortestPathCache c , _chainGraphHash = hash c } | otherwise = error "the given graph is not a valid chain graph" where - c = mapVertices f g + c = G.mapVertices f g {-# INLINE toChainGraph #-} -- | A valid chain graph is symmetric, regular, and the out-degree @@ -170,11 +182,11 @@ toChainGraph f g -- -- These properties imply that the graph is strongly connected. -- -validChainGraph :: DiGraph ChainId -> Bool +validChainGraph :: G.DiGraph ChainId -> Bool validChainGraph g - = isDiGraph g - && isSymmetric g - && isRegular g + = G.isDiGraph g + && G.isSymmetric g + && G.isRegular g && (G.order g <= 1 || G.size g >= 1) {-# INLINE validChainGraph #-} @@ -183,7 +195,7 @@ adjacentChainIds => ChainGraph -> p -> HS.HashSet ChainId -adjacentChainIds (ChainGraph g _ _) cid = adjacents (_chainId cid) g +adjacentChainIds (ChainGraph g _ _ _) cid = G.adjacents (_chainId cid) g {-# INLINE adjacentChainIds #-} -- -------------------------------------------------------------------------- -- @@ -204,7 +216,7 @@ pattern Adj a b <- AdjPair (a, b) adjs :: ChainGraph -> HS.HashSet (AdjPair ChainId) -adjs = HS.map (uncurry Adj) . edges . _chainGraphGraph +adjs = HS.map (uncurry Adj) . G.edges . _chainGraphGraph {-# INLINE adjs #-} adjsOfVertex @@ -227,12 +239,12 @@ degree :: ChainGraph -> Natural degree = G.minOutDegree . _chainGraphGraph diameter :: ChainGraph -> Natural -diameter = fromJuste . diameter_ . _chainGraphShortestPathCache +diameter = fromJuste . G.diameter_ . _chainGraphShortestPathCache -- this is safe, because we know that the graph is strongly connected shortestPath :: ChainId -> ChainId -> ChainGraph -> [ChainId] shortestPath src trg = fromJuste - . shortestPath_ src trg + . G.shortestPath_ src trg . _chainGraphShortestPathCache -- this is safe, because we know that the graph is strongly connected @@ -258,13 +270,9 @@ instance HasChainGraph ChainGraph where -- -------------------------------------------------------------------------- -- -- Checks with a given Graphs -chainIds :: Given ChainGraph => HS.HashSet ChainId -chainIds = vertices (_chainGraphGraph given) -{-# INLINE chainIds #-} - -chainIds_ :: ChainGraph -> HS.HashSet ChainId -chainIds_ = vertices . _chainGraphGraph -{-# INLINE chainIds_ #-} +graphChainIds :: ChainGraph -> HS.HashSet ChainId +graphChainIds = G.vertices . _chainGraphGraph +{-# INLINE graphChainIds #-} -- | Given a 'ChainGraph' @g@, @checkWebChainId p@ checks that @p@ is a vertex -- in @g@. @@ -272,12 +280,12 @@ chainIds_ = vertices . _chainGraphGraph checkWebChainId :: MonadThrow m => HasChainGraph g => HasChainId p => g -> p -> m () checkWebChainId g p = unless (isWebChain g p) $ throwM $ ChainNotInChainGraphException - (Expected (vertices $ _chainGraphGraph $ _chainGraph g)) + (Expected (G.vertices $ _chainGraphGraph $ _chainGraph g)) (Actual (_chainId p)) isWebChain :: HasChainGraph g => HasChainId p => g -> p -> Bool -isWebChain g p = isVertex (_chainId p) (_chainGraphGraph $ _chainGraph g) +isWebChain g p = G.isVertex (_chainId p) (_chainGraphGraph $ _chainGraph g) {-# INLINE isWebChain #-} -- | Given a 'ChainGraph' @g@, @checkAdjacentChainIds cid as@ checks that the @@ -297,17 +305,40 @@ checkAdjacentChainIds g cid expectedAdj = do checkWebChainId g cid void $ check AdjacentChainMismatch (HS.map _chainId <$> expectedAdj) - (Actual $ adjacents (_chainId cid) (_chainGraphGraph $ _chainGraph g)) + (Actual $ G.adjacents (_chainId cid) (_chainGraphGraph $ _chainGraph g)) return (getExpected expectedAdj) -- -------------------------------------------------------------------------- -- -- Some Graphs +-- | Graphs which have known, specific, intended meaning for Chainweb. +-- +data KnownGraph = Singleton | Pair | Triangle | Peterson | Twenty | HoffmanSingle + deriving (Generic) + deriving anyclass (NFData) + +knownGraph :: KnownGraph -> ChainGraph +knownGraph Singleton = singletonChainGraph +knownGraph Pair = pairChainGraph +knownGraph Triangle = triangleChainGraph +knownGraph Peterson = petersonChainGraph +knownGraph Twenty = twentyChainGraph +knownGraph HoffmanSingle = hoffmanSingletonGraph + singletonChainGraph :: ChainGraph -singletonChainGraph = toChainGraph (unsafeChainId . int) singleton +singletonChainGraph = toChainGraph (unsafeChainId . int) Singleton G.singleton pairChainGraph :: ChainGraph -pairChainGraph = toChainGraph (unsafeChainId . int) pair +pairChainGraph = toChainGraph (unsafeChainId . int) Pair G.pair + +triangleChainGraph :: ChainGraph +triangleChainGraph = toChainGraph (unsafeChainId . int) Triangle G.triangle petersonChainGraph :: ChainGraph -petersonChainGraph = toChainGraph (unsafeChainId . int) petersonGraph +petersonChainGraph = toChainGraph (unsafeChainId . int) Peterson G.petersonGraph + +twentyChainGraph :: ChainGraph +twentyChainGraph = toChainGraph (unsafeChainId . int) Twenty G.twentyChainGraph + +hoffmanSingletonGraph :: ChainGraph +hoffmanSingletonGraph = toChainGraph (unsafeChainId . int) HoffmanSingle G.hoffmanSingleton diff --git a/src/Chainweb/Mempool/Mempool.hs b/src/Chainweb/Mempool/Mempool.hs index 4aa0174c36..52f42797e4 100644 --- a/src/Chainweb/Mempool/Mempool.hs +++ b/src/Chainweb/Mempool/Mempool.hs @@ -263,18 +263,20 @@ syncMempools' log0 localMempool remoteMempool onInitialSyncComplete = log = log0 Info -- TODO: some of these messages should be -- "debug" but we're ok with overlogging for -- now. + deb :: Text -> IO () + deb = log0 Debug sync _ = flip finally (log "sync finished") $ do - log "subscription started, getting pending hashes from remote" + deb "subscription started, getting pending hashes from remote" missing <- newIORef $! SyncState 0 [] HashSet.empty False mempoolGetPendingTransactions remoteMempool $ syncChunk missing (SyncState _ missingChunks presentHashes tooMany) <- readIORef missing - log "subscription started, getting pending hashes from remote" + deb "subscription started, getting pending hashes from remote" let numMissingFromLocal = foldl' (+) 0 (map V.length missingChunks) let numPresentAtRemote = HashSet.size presentHashes - log $ T.concat [ + deb $ T.concat [ sshow (numMissingFromLocal + numPresentAtRemote) , " hashes at remote (" , sshow numMissingFromLocal @@ -286,7 +288,7 @@ syncMempools' log0 localMempool remoteMempool onInitialSyncComplete = -- Push our missing txs to remote. numPushed <- push presentHashes - log $ T.concat [ + deb $ T.concat [ "pushed " , sshow numPushed , " new transactions to remote." diff --git a/src/Chainweb/Miner/POW.hs b/src/Chainweb/Miner/POW.hs index 479a1db0d9..3ea9d60769 100644 --- a/src/Chainweb/Miner/POW.hs +++ b/src/Chainweb/Miner/POW.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} @@ -17,22 +18,43 @@ -- A true Proof of Work miner. -- -module Chainweb.Miner.POW ( powMiner ) where +module Chainweb.Miner.POW +( powMiner -import Control.Lens (ix, (^?), (^?!), view) +-- * Internal +, mineCut +, mine +) where +import Control.Concurrent.Async +import Control.Lens +import Control.Monad +import Control.Monad.STM + +import Crypto.Hash.Algorithms +import Crypto.Hash.IO + +import qualified Data.ByteArray as BA +import Data.Bytes.Put +import qualified Data.ByteString as B import qualified Data.HashMap.Strict as HM +import Data.Int +import Data.Proxy import Data.Reflection (Given, give) -import qualified Data.Sequence as S import qualified Data.Text as T import Data.Tuple.Strict (T2(..), T3(..)) +import Data.Word + +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable import System.LogLevel (LogLevel(..)) import qualified System.Random.MWC as MWC -- internal modules -import Chainweb.BlockHash (BlockHash) +import Chainweb.BlockHash (BlockHash, BlockHashRecord(..)) import Chainweb.BlockHeader import Chainweb.BlockHeaderDB (BlockHeaderDb) import Chainweb.ChainId (ChainId) @@ -41,27 +63,18 @@ import Chainweb.Cut.CutHashes import Chainweb.CutDB import Chainweb.Difficulty import Chainweb.Miner.Config (MinerConfig(..)) -import Chainweb.NodeId (NodeId) +import Chainweb.NodeId (NodeId, nodeIdFromNodeId) import Chainweb.Payload import Chainweb.Payload.PayloadStore import Chainweb.Sync.WebBlockHeaderStore -import Chainweb.Time (getCurrentTimeIntegral) +import Chainweb.Time import Chainweb.TreeDB.Difficulty (hashTarget) import Chainweb.Utils +import Chainweb.Version import Chainweb.WebBlockHeaderDB import Chainweb.WebPactExecutionService -import Data.LogMessage (LogFunction, JsonLog(..)) - --- DEBUGGING -- --- import Chainweb.ChainId (testChainId) --- import Chainweb.Difficulty (PowHashNat(..), HashDifficulty(..)) --- import Chainweb.Time (Time(..), TimeSpan(..)) --- import Data.Generics.Wrapped (_Unwrapped) --- import Data.IORef --- import Data.Int (Int64) --- import System.IO (hFlush, stdout) --- import Text.Printf (printf) +import Data.LogMessage (JsonLog(..), LogFunction) -- -------------------------------------------------------------------------- -- -- Miner @@ -82,7 +95,6 @@ powMiner logFun conf nid cutDb = runForever logFun "POW Miner" $ do where wcdb = view cutDbWebBlockHeaderDb cutDb payloadDb = view cutDbPayloadCas cutDb - payloadStore = view cutDbPayloadStore cutDb logg :: LogLevel -> T.Text -> IO () logg = logFun @@ -96,13 +108,14 @@ powMiner logFun conf nid cutDb = runForever logFun "POW Miner" $ do -> IO () go gen !i !adjustments0 = do - nonce0 <- Nonce <$> MWC.uniform gen - - -- counter <- newIORef (1 :: Int) - - -- Mine a new block + -- Mine a new Cut -- - T3 newBh c' adjustments' <- mine nonce0 adjustments0 + c <- _cut cutDb + T3 newBh c' adjustments' <- do + let go2 !x = race (awaitNextCut cutDb x) (mineCut @cas logFun conf nid cutDb gen x adjustments0) >>= \case + Left c' -> go2 c' + Right !r -> return r + go2 c logg Info $! "created new block" <> sshow i logFun @(JsonLog NewMinedBlock) Info $ JsonLog (NewMinedBlock (ObjectEncoded newBh)) @@ -132,101 +145,108 @@ powMiner logFun conf nid cutDb = runForever logFun "POW Miner" $ do -- go gen (i + 1) (HM.filter (\(T2 h _) -> h > limit) adjustments') - -- | INVARIANT: A new cut, chain, and parent header is reselected after each - -- hash failure. This ensures that the Cut the miner is working on doesn't - -- grow stale, and cause forks. Without this condition (or a similar one), - -- the miners cause forks quite aggressively. +awaitNextCut :: CutDb cas -> Cut -> IO Cut +awaitNextCut cutDb c = atomically $ do + c' <- _cutStm cutDb + when (c' == c) retry + return c' + +mineCut + :: PayloadCas cas + => Given WebBlockHeaderDb + => Given (PayloadDb cas) + => LogFunction + -> MinerConfig + -> NodeId + -> CutDb cas + -> MWC.GenIO + -> Cut + -> Adjustments + -> IO (T3 BlockHeader Cut Adjustments) +mineCut logfun conf nid cutDb gen !c !adjustments = do + + -- Randomly pick a chain to mine on. -- - mine - :: Given WebBlockHeaderDb - => Given (PayloadDb cas) - => Nonce - -> Adjustments - -> IO (T3 BlockHeader Cut Adjustments) - mine !nonce !adjustments = do - -- Get the current longest cut. - -- - c <- _cut cutDb + cid <- randomChainId c - -- Randomly pick a chain to mine on. - -- - cid <- randomChainId c + -- The parent block the mine on. Any given chain will always + -- contain at least a genesis block, so this otherwise naughty + -- `^?!` will always succeed. + -- + let !p = c ^?! ixg cid - -- The parent block the mine on. Any given chain will always - -- contain at least a genesis block, so this otherwise naughty - -- `^?!` will always succeed. - -- - let !p = c ^?! ixg cid + -- check if chain can be mined on (check adjacent parents) + -- + case getAdjacentParents c p of + + Nothing -> mineCut logfun conf nid cutDb gen c adjustments + -- spin until a chain is found that isn't blocked + + Just adjParents -> do + + -- get payload + payload <- _pactNewBlock pact (_configMinerInfo conf) p + + -- get target + -- + T2 target adjustments' <- getTarget cid p adjustments + + -- Assemble block without Nonce and Timestamp + -- + creationTime <- getCurrentTimeIntegral + nonce <- Nonce <$> MWC.uniform gen + let candidateHeader = newBlockHeader + (nodeIdFromNodeId nid cid) + adjParents + (_payloadWithOutputsPayloadHash payload) + nonce + target + creationTime + p + + newHeader <- usePowHash v mine candidateHeader nonce + + -- create cut with new block + -- + -- This is expected to succeed, since the cut invariants should + -- hold by construction + -- + !c' <- monotonicCutExtension c newHeader + + -- Validate payload + -- + logg Info $! "validate block payload" + validatePayload newHeader payload + logg Info $! "add block payload to payload cas" + addNewPayload payloadDb payload + + logg Info $! "add block to payload db" + insertWebBlockHeaderDb newHeader + + return $! T3 newHeader c' adjustments' - -- The hashing target to be lower than. - -- - T2 target adjustments' <- getTarget cid p adjustments + where + v = _chainwebVersion cutDb + wcdb = view cutDbWebBlockHeaderDb cutDb + payloadDb = view cutDbPayloadCas cutDb + payloadStore = view cutDbPayloadStore cutDb + pact = _webPactExecutionService $ _webBlockPayloadStorePact payloadStore - -- Loops (i.e. "mines") if a non-matching nonce was generated. - -- + logg :: LogLevel -> T.Text -> IO () + logg = logfun - let mokPact = False - let pact = _webPactExecutionService $ _webBlockPayloadStorePact payloadStore - payload <- case mokPact of - False -> _pactNewBlock pact (_configMinerInfo conf) p - True -> return - $ newPayloadWithOutputs (MinerData "miner") (CoinbaseOutput "coinbase") - $ S.fromList - [ (Transaction "testTransaction", TransactionOutput "testOutput") - ] - - -- The new block's creation time. - -- - let loop n = do - ct <- getCurrentTimeIntegral - testMineWithPayload @cas nonce target ct payload nid cid c pact >>= \case - Left BadNonce -> do - -- atomicModifyIORef' counter (\n -> (succ n, ())) - c' <- _cut cutDb - - -- this comparision is still a bit expensive but fine for now. We - -- should let cutdb notify us. Or use a serial number or similar. - if c' /= c - then mine (succ n) adjustments' - else loop (succ n) - - Left BadAdjacents -> mine nonce adjustments' - - Right (T2 newBh newCut) -> do - - -- DEBUGGING -- - -- Uncomment the following for a live view of mining - -- results on Chain 0. You will have to uncomment a - -- number of surrounding helper values and readd some - -- imports. - - -- total <- readIORef counter - - -- let targetBits :: String - -- targetBits = printf "%0256b" $ htInteger target - - -- when (cid == testChainId 0) $ do - -- printf "\n--- NODE:%02d HASHES:%06x TARGET:%s...%s HEIGHT:%03x WEIGHT:%06x PARENT:%s NEW:%s TIME:%02.2f\n" - -- (_nodeIdId nid) - -- total - -- (take 30 targetBits) - -- (drop 226 targetBits) - -- (pheight newBh) - -- (pweight newBh) - -- (take 8 . drop 5 . show $ _blockHash p) - -- (take 8 . drop 5 . show $ _blockHash newBh) - -- (int (time newBh - time p) / 1000000 :: Float) - -- hFlush stdout - - pure $! T3 newBh newCut adjustments' - loop nonce + blockDb :: ChainId -> Maybe BlockHeaderDb + blockDb cid = wcdb ^? webBlockHeaderDb . ix cid + + validatePayload :: BlockHeader -> PayloadWithOutputs -> IO () + validatePayload h o = void $ _pactValidateBlock pact h $ toPayloadData o getTarget :: ChainId -> BlockHeader -> Adjustments -> IO (T2 HashTarget Adjustments) - getTarget cid bh adjustments = case HM.lookup (_blockHash bh) adjustments of + getTarget cid bh as = case HM.lookup (_blockHash bh) as of Just (T2 _ t) -> pure $! T2 t adjustments Nothing -> case blockDb cid of Nothing -> pure $! T2 (_blockTarget bh) adjustments @@ -234,18 +254,139 @@ powMiner logFun conf nid cutDb = runForever logFun "POW Miner" $ do t <- hashTarget db bh pure $! T2 t (HM.insert (_blockHash bh) (T2 (_blockHeight bh) t) adjustments) - blockDb :: ChainId -> Maybe BlockHeaderDb - blockDb cid = wcdb ^? webBlockHeaderDb . ix cid + toPayloadData d = PayloadData + { _payloadDataTransactions = fst <$> _payloadWithOutputsTransactions d + , _payloadDataMiner = _payloadWithOutputsMiner d + , _payloadDataPayloadHash = _payloadWithOutputsPayloadHash d + , _payloadDataTransactionsHash = _payloadWithOutputsTransactionsHash d + , _payloadDataOutputsHash = _payloadWithOutputsOutputsHash d + } + +-- -------------------------------------------------------------------------- -- +-- + +getAdjacentParents + :: (IxedGet s, IxValue s ~ BlockHeader, Index s ~ ChainId) + => s + -> BlockHeader + -> Maybe BlockHashRecord +getAdjacentParents c p = BlockHashRecord <$> newAdjHashes + where + -- | Try to get all adjacent hashes dependencies. + -- + newAdjHashes :: Maybe (HM.HashMap ChainId BlockHash) + newAdjHashes = iforM (_getBlockHashRecord $ _blockAdjacentHashes p) $ \xcid _ -> + c ^?! ixg xcid . to (tryAdj (_blockHeight p)) + + tryAdj :: BlockHeight -> BlockHeader -> Maybe BlockHash + tryAdj h b + | _blockHeight b == h = Just $! _blockHash b + | _blockHeight b == h + 1 = Just $! _blockParent b + | otherwise = Nothing - -- htInteger :: HashTarget -> Integer - -- htInteger (HashTarget (PowHashNat w)) = fromIntegral w +-- -------------------------------------------------------------------------- -- +-- Inner Mining loop + +usePowHash :: ChainwebVersion -> (forall a . HashAlgorithm a => Proxy a -> f) -> f +usePowHash Test{} f = f $ Proxy @SHA512t_256 +usePowHash TestWithTime{} f = f $ Proxy @SHA512t_256 +usePowHash TestWithPow{} f = f $ Proxy @SHA512t_256 +usePowHash Testnet00{} f = f $ Proxy @SHA512t_256 +usePowHash Testnet01{} f = f $ Proxy @SHA512t_256 - -- pheight :: BlockHeader -> Word64 - -- pheight bh = case _blockHeight bh of BlockHeight w -> w +-- | This Miner makes low-level assumptions about the chainweb protocol. It may +-- break if the protocol changes. +-- +-- TODO: Check the chainweb version to make sure this function can handle the +-- respective version. +-- +mine + :: forall a + . HashAlgorithm a + => Proxy a + -> BlockHeader + -> Nonce + -> IO BlockHeader +mine _ h nonce = BA.withByteArray initialTargetBytes $ \trgPtr -> do + !ctx <- hashMutableInit @a + bytes <- BA.copy initialBytes $ \buf -> + allocaBytes (powSize :: Int) $ \pow -> do + + -- inner mining loop + -- + -- We do 100000 hashes before we update the creation time. + -- + let go 100000 !n = do + + -- update the block creation time + ct <- getCurrentTimeIntegral + injectTime ct buf + go 0 n + + go !i !n = do + + -- Compute POW hash for the nonce + injectNonce n buf + hash ctx buf pow + + -- check whether the nonce meets the target + fastCheckTarget trgPtr (castPtr pow) >>= \case + True -> return () + False -> go (succ i) (succ n) + + -- Start inner mining loop + go (0 :: Int) nonce + + -- On success: deserialize and returnb the new BlockHeader + runGet decodeBlockHeaderWithoutHash bytes - -- pweight :: BlockHeader -> Integer - -- pweight bh = case _blockWeight bh of - -- BlockWeight (HashDifficulty (PowHashNat w)) -> int w + where - -- time :: BlockHeader -> Int64 - -- time h = case _blockCreationTime h of BlockCreationTime (Time (TimeSpan n)) -> n + !initialBytes = runPutS $ encodeBlockHeaderWithoutHash h + !bufSize = B.length initialBytes + !target = _blockTarget h + !initialTargetBytes = runPutS $ encodeHashTarget target + !powSize = int $ hashDigestSize @a undefined + + -- Compute POW hash + hash :: MutableContext a -> Ptr Word8 -> Ptr Word8 -> IO () + hash ctx buf pow = do + hashMutableReset ctx + BA.withByteArray ctx $ \ctxPtr -> do + hashInternalUpdate @a ctxPtr buf (int bufSize) + hashInternalFinalize ctxPtr (castPtr pow) + {-# INLINE hash #-} + + injectTime :: Time Int64 -> Ptr Word8 -> IO () + injectTime t buf = pokeByteOff buf 8 $ encodeTimeToWord64 t + {-# INLINE injectTime #-} + + injectNonce :: Nonce -> Ptr Word8 -> IO () + injectNonce n buf = poke (castPtr buf) $ encodeNonceToWord64 n + {-# INLINE injectNonce #-} + + -- | `PowHashNat` interprets POW hashes as unsigned 256 bit integral numbers + -- in little endian encoding. + -- + fastCheckTarget :: Ptr Word64 -> Ptr Word64 -> IO Bool + fastCheckTarget !trgPtr !powPtr = + fastCheckTargetN 3 trgPtr powPtr >>= \case + LT -> return False + GT -> return True + EQ -> fastCheckTargetN 2 trgPtr powPtr >>= \case + LT -> return False + GT -> return True + EQ -> fastCheckTargetN 1 trgPtr powPtr >>= \case + LT -> return False + GT -> return True + EQ -> fastCheckTargetN 0 trgPtr powPtr >>= \case + LT -> return False + GT -> return True + EQ -> return True + {-# INLINE fastCheckTarget #-} + + fastCheckTargetN :: Int -> Ptr Word64 -> Ptr Word64 -> IO Ordering + fastCheckTargetN n trgPtr powPtr = compare + <$> peekElemOff trgPtr n + <*> peekElemOff powPtr n + {-# INLINE fastCheckTargetN #-} diff --git a/src/Chainweb/Miner/Test.hs b/src/Chainweb/Miner/Test.hs index f9fc04ee1a..561dec2ff9 100644 --- a/src/Chainweb/Miner/Test.hs +++ b/src/Chainweb/Miner/Test.hs @@ -43,6 +43,7 @@ import qualified System.Random.MWC.Distributions as MWC import Chainweb.BlockHeader import Chainweb.Cut import Chainweb.Cut.CutHashes +import Chainweb.Cut.Test import Chainweb.CutDB import Chainweb.Difficulty (BlockRate(..), blockRate) import Chainweb.Graph diff --git a/src/Chainweb/Pact/PactService.hs b/src/Chainweb/Pact/PactService.hs index a90b141c90..8f88e9c3a3 100644 --- a/src/Chainweb/Pact/PactService.hs +++ b/src/Chainweb/Pact/PactService.hs @@ -73,8 +73,9 @@ import qualified Pact.Types.SQLite as P -- internal modules import Chainweb.BlockHash -import Chainweb.BlockHeader (BlockHeader(..), BlockHeight(..), isGenesisBlockHeader) -import Chainweb.ChainId (ChainId, unsafeGetChainId) +import Chainweb.BlockHeader + (BlockHeader(..), BlockHeight(..), isGenesisBlockHeader) +import Chainweb.ChainId (ChainId, chainIdInt) import Chainweb.CutDB (CutDb) import Chainweb.Logger import Chainweb.Pact.Backend.InMemoryCheckpointer (initInMemoryCheckpointEnv) @@ -103,8 +104,8 @@ pactDbConfig :: ChainwebVersion -> PactDbConfig pactDbConfig Test{} = PactDbConfig Nothing "log-unused" [] (Just 0) (Just 0) pactDbConfig TestWithTime{} = PactDbConfig Nothing "log-unused" [] (Just 0) (Just 0) pactDbConfig TestWithPow{} = PactDbConfig Nothing "log-unused" [] (Just 0) (Just 0) -pactDbConfig Simulation{} = PactDbConfig Nothing "log-unused" [] (Just 0) (Just 0) pactDbConfig Testnet00 = PactDbConfig Nothing "log-unused" [] (Just 0) (Just 0) +pactDbConfig Testnet01 = PactDbConfig Nothing "log-unused" [] (Just 0) (Just 0) pactLogLevel :: String -> LogLevel pactLogLevel "INFO" = Info @@ -172,7 +173,7 @@ initPactService' ver cid chainwebLogger spv act = do internalError' s Right _ -> return () - let !pd = P.PublicData def (unsafeGetChainId cid) def def + let !pd = P.PublicData def (chainIdInt cid) def def let !pse = PactServiceEnv Nothing checkpointEnv spv pd evalStateT (runReaderT act pse) (PactServiceState theState Nothing) @@ -219,8 +220,8 @@ initialPayloadState :: ChainwebVersion -> ChainId -> PactServiceM () initialPayloadState Test{} _ = return () initialPayloadState v@TestWithTime{} cid = createCoinContract v cid initialPayloadState TestWithPow{} _ = return () -initialPayloadState Simulation{} _ = return () initialPayloadState v@Testnet00 cid = createCoinContract v cid +initialPayloadState v@Testnet01 cid = createCoinContract v cid createCoinContract :: ChainwebVersion -> ChainId -> PactServiceM () createCoinContract v cid = do diff --git a/src/Chainweb/Payload/PayloadStore.hs b/src/Chainweb/Payload/PayloadStore.hs index 95dd88cad3..b698bd7b4f 100644 --- a/src/Chainweb/Payload/PayloadStore.hs +++ b/src/Chainweb/Payload/PayloadStore.hs @@ -65,7 +65,6 @@ import qualified Data.Sequence as S -- internal modules import Chainweb.BlockHeader.Genesis (genesisBlockPayload) -import Chainweb.Graph import Chainweb.Payload import Chainweb.Version @@ -214,7 +213,7 @@ initializePayloadDb => ChainwebVersion -> PayloadDb cas -> IO () -initializePayloadDb v db = traverse_ initForChain $ chainIds_ $ _chainGraph v +initializePayloadDb v db = traverse_ initForChain $ chainIds v where initForChain cid = do addNewPayload db $ genesisBlockPayload v cid diff --git a/src/Chainweb/PowHash.hs b/src/Chainweb/PowHash.hs index 3b41a74c9f..c0d4efc897 100644 --- a/src/Chainweb/PowHash.hs +++ b/src/Chainweb/PowHash.hs @@ -139,8 +139,8 @@ powHash :: ChainwebVersion -> B.ByteString -> PowHash powHash Test{} = cryptoHash @SHA512t_256 powHash TestWithTime{} = cryptoHash @SHA512t_256 powHash TestWithPow{} = cryptoHash @SHA512t_256 -powHash Simulation {}= cryptoHash @SHA512t_256 powHash Testnet00 = cryptoHash @SHA512t_256 +powHash Testnet01 = cryptoHash @SHA512t_256 cryptoHash :: forall a . HashAlgorithm a => B.ByteString -> PowHash cryptoHash = PowHash . SB.toShort . BA.convert . C.hash @_ @a diff --git a/src/Chainweb/RestAPI/Orphans.hs b/src/Chainweb/RestAPI/Orphans.hs index d6ece7d3bf..cd0114d5ed 100644 --- a/src/Chainweb/RestAPI/Orphans.hs +++ b/src/Chainweb/RestAPI/Orphans.hs @@ -249,8 +249,7 @@ instance ToParamSchema ChainwebVersion where toParamSchema _ = mempty & type_ .~ SwaggerString & enum_ ?~ (toJSON <$> - [ Simulation petersonChainGraph - , Test petersonChainGraph + [ Test petersonChainGraph , TestWithTime petersonChainGraph , TestWithPow petersonChainGraph , Testnet00 diff --git a/src/Chainweb/SPV/RestAPI/Server.hs b/src/Chainweb/SPV/RestAPI/Server.hs index 50abbebc28..0959040f18 100644 --- a/src/Chainweb/SPV/RestAPI/Server.hs +++ b/src/Chainweb/SPV/RestAPI/Server.hs @@ -42,7 +42,6 @@ import Servant import Chainweb.BlockHeader import Chainweb.ChainId import Chainweb.CutDB -import Chainweb.Graph import Chainweb.Payload.PayloadStore import Chainweb.RestAPI.Utils import Chainweb.SPV @@ -155,5 +154,5 @@ someSpvServers someSpvServers v db = mconcat $ flip fmap cids $ \(FromSing (SChainId :: Sing c)) -> someSpvServer @_ @c (someCutDbVal v db) where - cids = toList . chainIds_ $ _chainGraph db + cids = toList $ chainIds db diff --git a/src/Chainweb/Sync/WebBlockHeaderStore.hs b/src/Chainweb/Sync/WebBlockHeaderStore.hs index 7cb616e65f..a65a504d12 100644 --- a/src/Chainweb/Sync/WebBlockHeaderStore.hs +++ b/src/Chainweb/Sync/WebBlockHeaderStore.hs @@ -316,7 +316,30 @@ getBlockHeaderInternal headerStore payloadStore priority maybeOrigin h = do logg Debug $ "getBlockHeaderInternal got pre-requesites for " <> sshow h - -- Validate block header + -- ------------------------------------------------------------------ -- + -- Validation + + -- 1. Validate Parents and Adjacent Parents + -- + -- Existence and validitey of parents and adjacent parents is guaranteed + -- in the dependency resolution code above. + + -- 2. Validate BlockHeader + -- + -- Single chain properties are currently validated when the block header + -- is inserted into the block header db. + + -- 3. Validate Braiding + -- + -- Currently, we allow blocks here that are not part of a valid + -- braiding. However, those block won't make it into cuts, because the + -- cut processor uses 'joinIntoHeavier' to combine an external cut with + -- the local cut, which guarantees that only blocks with valid braiding + -- are referenced by local cuts. + -- + -- TODO: check braiding and reject blocks without valid braiding here. + + -- 4. Validate block payload -- -- Pact validation is done in the context of a particular header. Just -- because the payload does already exist in the store doesn't mean that diff --git a/src/Chainweb/Time.hs b/src/Chainweb/Time.hs index c362664af2..a95e3625e6 100644 --- a/src/Chainweb/Time.hs +++ b/src/Chainweb/Time.hs @@ -29,6 +29,7 @@ module Chainweb.Time -- * TimeSpan TimeSpan(..) , encodeTimeSpan +, encodeTimeSpanToWord64 , decodeTimeSpan , castTimeSpan , maybeCastTimeSpan @@ -42,6 +43,7 @@ module Chainweb.Time , minTime , maxTime , encodeTime +, encodeTimeToWord64 , decodeTime , castTime , maybeCastTime @@ -69,6 +71,7 @@ import Control.DeepSeq import Control.Monad.Catch import Data.Aeson (FromJSON, ToJSON) +import qualified Data.Memory.Endian as BA import Data.Bytes.Get import Data.Bytes.Put import Data.Bytes.Signed @@ -77,6 +80,7 @@ import Data.Int import Data.Kind import qualified Data.Text as T import Data.Time.Clock.POSIX +import Data.Word import GHC.Generics @@ -109,6 +113,10 @@ encodeTimeSpan :: MonadPut m => TimeSpan Int64 -> m () encodeTimeSpan (TimeSpan a) = putWord64le $ unsigned a {-# INLINE encodeTimeSpan #-} +encodeTimeSpanToWord64 :: TimeSpan Int64 -> Word64 +encodeTimeSpanToWord64 (TimeSpan a) = BA.unLE . BA.toLE $ unsigned a +{-# INLINE encodeTimeSpanToWord64 #-} + decodeTimeSpan :: MonadGet m => m (TimeSpan Int64) decodeTimeSpan = TimeSpan . signed <$> getWord64le {-# INLINE decodeTimeSpan #-} @@ -171,6 +179,10 @@ encodeTime :: MonadPut m => Time Int64 -> m () encodeTime (Time a) = encodeTimeSpan a {-# INLINE encodeTime #-} +encodeTimeToWord64 :: Time Int64 -> Word64 +encodeTimeToWord64 (Time a) = encodeTimeSpanToWord64 a +{-# INLINE encodeTimeToWord64 #-} + decodeTime :: MonadGet m => m (Time Int64) decodeTime = Time <$> decodeTimeSpan {-# INLINE decodeTime #-} diff --git a/src/Chainweb/TreeDB.hs b/src/Chainweb/TreeDB.hs index 99e0097c6b..65d179a39a 100644 --- a/src/Chainweb/TreeDB.hs +++ b/src/Chainweb/TreeDB.hs @@ -29,7 +29,9 @@ module Chainweb.TreeDB -- * Query Parameters , MinRank(..) +, _getMinRank , MaxRank(..) +, _getMaxRank , LowerBound(..) , UpperBound(..) , BranchBounds(..) diff --git a/src/Chainweb/TreeDB/Difficulty.hs b/src/Chainweb/TreeDB/Difficulty.hs index 197412227d..b917925595 100644 --- a/src/Chainweb/TreeDB/Difficulty.hs +++ b/src/Chainweb/TreeDB/Difficulty.hs @@ -55,10 +55,9 @@ hashTarget db bh & fmap fromJuste -- Thanks to the two guard conditions above, -- this will (should) always succeed. - let - -- The time difference in microseconds between when the earliest and - -- latest blocks in the window were mined. - delta :: TimeSpan Int64 + -- The time difference in microseconds between when the earliest and + -- latest blocks in the window were mined. + let delta :: TimeSpan Int64 !delta = TimeSpan $ time bh' - time start pure . adjust ver delta $ _blockTarget bh' diff --git a/src/Chainweb/Version.hs b/src/Chainweb/Version.hs index 200556b551..e3165f6f59 100644 --- a/src/Chainweb/Version.hs +++ b/src/Chainweb/Version.hs @@ -9,10 +9,13 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wno-redundant-constraints #-} + -- | -- Module: Chainweb.Version -- Copyright: Copyright © 2018 Kadena LLC. @@ -44,33 +47,62 @@ module Chainweb.Version -- * HasChainwebVersion , HasChainwebVersion(..) - +, mkChainId +, chainIds +, someChainId +, randomChainId + +-- * ChainId +, module Chainweb.ChainId + +-- * Re-exports from Chainweb.ChainGraph + +-- ** Chain Graph +, ChainGraph +, HasChainGraph(..) +, adjacentChainIds + +-- ** Graph Properties +, order +, diameter +, degree +, shortestPath + +-- ** Undirected Edges +, AdjPair +, _getAdjPair +, pattern Adj +, adjs +, adjsOfVertex +, checkAdjacentChainIds ) where -import Control.Concurrent.STM.TVar import Control.DeepSeq import Control.Lens import Control.Monad.Catch -import Control.Monad.STM -import Data.Aeson +import Data.Aeson hiding (pairs) import Data.Bits import Data.Bytes.Get import Data.Bytes.Put +import Data.Foldable import Data.Hashable import qualified Data.HashMap.Strict as HM +import qualified Data.HashSet as HS import Data.Proxy import qualified Data.Text as T +import Data.Tuple (swap) import Data.Word import GHC.Generics (Generic) import GHC.Stack import GHC.TypeLits -import System.IO.Unsafe +import System.Random -- internal modules +import Chainweb.ChainId import Chainweb.Crypto.MerkleLog import Chainweb.Graph import Chainweb.MerkleUniverse @@ -123,8 +155,8 @@ data ChainwebVersion -- * creationTime of BlockHeaders is actual time. -- - | Simulation ChainGraph | Testnet00 + | Testnet01 deriving (Eq, Ord, Generic) deriving anyclass (Hashable, NFData) @@ -132,24 +164,31 @@ instance Show ChainwebVersion where show = T.unpack . toText {-# INLINE show #-} -isTestChainwebVersionId :: Word32 -> Bool -isTestChainwebVersionId i = 0x80000000 .&. i /= 0x0 -{-# INLINABLE isTestChainwebVersionId #-} - +-- | This function and its dual `fromChainwebVersionId` are used to efficiently +-- serialize a `ChainwebVersion` and its associated internal `ChainGraph` value. +-- __This function must be injective (one-to-one)!__ The scheme is as follows: +-- +-- * Production `ChainwebVersion`s start from @0x00000001@ and count upwards. +-- Their value must be less than @0x8000000@, but this limit is unlikely to +-- ever be reached. +-- +-- * `ChainwebVersion`s for testing begin at @0x80000000@, as can be seen in +-- `toTestChainwebVersion`. This value is combined (via `.|.`) with the +-- "code" of their associated `ChainGraph` (as seen in `graphToCode`). Such +-- codes start at @0x00010000@ and count upwards. +-- chainwebVersionId :: ChainwebVersion -> Word32 -chainwebVersionId v@Test{} = toTestChainwebVersion v 0x80000000 -chainwebVersionId v@TestWithTime{} = toTestChainwebVersion v 0x80000001 -chainwebVersionId v@TestWithPow{} = toTestChainwebVersion v 0x80000002 -chainwebVersionId v@Simulation{} = toTestChainwebVersion v 0x80000003 +chainwebVersionId v@Test{} = toTestChainwebVersion v +chainwebVersionId v@TestWithTime{} = toTestChainwebVersion v +chainwebVersionId v@TestWithPow{} = toTestChainwebVersion v chainwebVersionId Testnet00 = 0x00000001 +chainwebVersionId Testnet01 = 0x00000002 {-# INLINABLE chainwebVersionId #-} -fromChainwebVersionId :: MonadGet m => Word32 -> m ChainwebVersion -fromChainwebVersionId i - | isTestChainwebVersionId i = return $ fromTestChainwebVersionId i - | otherwise = case i of - 0x00000001 -> return Testnet00 - _ -> fail $ "Unknown Chainweb version id: " ++ show i +fromChainwebVersionId :: HasCallStack => Word32 -> ChainwebVersion +fromChainwebVersionId 0x00000001 = Testnet00 +fromChainwebVersionId 0x00000002 = Testnet01 +fromChainwebVersionId i = fromTestChainwebVersionId i {-# INLINABLE fromChainwebVersionId #-} encodeChainwebVersion :: MonadPut m => ChainwebVersion -> m () @@ -157,7 +196,7 @@ encodeChainwebVersion = putWord32le . chainwebVersionId {-# INLINABLE encodeChainwebVersion #-} decodeChainwebVersion :: MonadGet m => m ChainwebVersion -decodeChainwebVersion = getWord32le >>= fromChainwebVersionId +decodeChainwebVersion = fromChainwebVersionId <$> getWord32le {-# INLINABLE decodeChainwebVersion #-} instance ToJSON ChainwebVersion where @@ -174,52 +213,25 @@ instance IsMerkleLogEntry ChainwebHashTag ChainwebVersion where {-# INLINE toMerkleNode #-} {-# INLINE fromMerkleNode #-} -chainwebVersionToText :: ChainwebVersion -> T.Text - --- production versions +chainwebVersionToText :: HasCallStack => ChainwebVersion -> T.Text chainwebVersionToText Testnet00 = "testnet00" - --- test versions -chainwebVersionToText v@Test{} = "test-" <> sshow (chainwebVersionId v) -chainwebVersionToText v@TestWithTime{} = "testWithTime-" <> sshow (chainwebVersionId v) -chainwebVersionToText v@TestWithPow{} = "testWithPow-" <> sshow (chainwebVersionId v) -chainwebVersionToText v@Simulation{} = "simulation-" <> sshow (chainwebVersionId v) +chainwebVersionToText Testnet01 = "testnet01" +chainwebVersionToText v = fromJuste $ HM.lookup v prettyVersions {-# INLINABLE chainwebVersionToText #-} --- | Read textual representation of Chainweb Version +-- | Read textual representation of a `ChainwebVersion`. -- chainwebVersionFromText :: MonadThrow m => T.Text -> m ChainwebVersion - --- Production versions --- -chainwebVersionFromText "testnet00" = return Testnet00 - --- Well-known test version names. --- --- These are only used for parsing textual representations. There is a very low --- chance that a roundtrip test for the 'HasTextRepresentation' of --- 'ChainwebVersion' will succeed due to these names. --- -chainwebVersionFromText "test" = return $ Test petersonChainGraph -chainwebVersionFromText "test-singleton" = return $ Test singletonChainGraph -chainwebVersionFromText "test-peterson" = return $ Test petersonChainGraph - -chainwebVersionFromText "testWithTime" = return $ TestWithTime petersonChainGraph -chainwebVersionFromText "testWithTime-singleton" = return $ TestWithTime singletonChainGraph -chainwebVersionFromText "testWithTime-peterson" = return $ TestWithTime petersonChainGraph - -chainwebVersionFromText "testWithPow" = return $ TestWithPow petersonChainGraph -chainwebVersionFromText "testWithPow-singleton" = return $ TestWithPow singletonChainGraph -chainwebVersionFromText "testWithPow-peterson" = return $ TestWithPow petersonChainGraph - --- Generic test versions --- -chainwebVersionFromText t = case T.breakOnEnd "-" t of - (_, i) -> case treadM i of - Left e -> throwM - $ TextFormatException $ "Unknown Chainweb version: \"" <> t <> "\": " <> sshow e - Right x -> return $ fromTestChainwebVersionId x -{-# INLINABLE chainwebVersionFromText #-} +chainwebVersionFromText "testnet00" = pure Testnet00 +chainwebVersionFromText "testnet01" = pure Testnet01 +chainwebVersionFromText t = + case HM.lookup t chainwebVersions of + Just v -> pure v + Nothing -> case t of + "test" -> pure $ Test petersonChainGraph + "testWithTime" -> pure $ TestWithTime petersonChainGraph + "testWithPow" -> pure $ TestWithPow petersonChainGraph + _ -> throwM . TextFormatException $ "Unknown Chainweb version: " <> t instance HasTextRepresentation ChainwebVersion where toText = chainwebVersionToText @@ -227,57 +239,84 @@ instance HasTextRepresentation ChainwebVersion where fromText = chainwebVersionFromText {-# INLINE fromText #-} +-- -------------------------------------------------------------------------- -- +-- Value Maps + +chainwebVersions :: HM.HashMap T.Text ChainwebVersion +chainwebVersions = HM.fromList $ + f Test "test" + <> f TestWithTime "testWithTime" + <> f TestWithPow "testWithPow" + <> [ ("testnet00", Testnet00), ("testnet01", Testnet01) ] + where + f v p = map (\(k, g) -> (p <> k, v g)) pairs + pairs = [ ("-singleton", singletonChainGraph) + , ("-pair", pairChainGraph) + , ("-triangle", triangleChainGraph) + , ("-peterson", petersonChainGraph) + , ("-twenty", twentyChainGraph) + , ("-hoffman-singleton", hoffmanSingletonGraph) + ] + +prettyVersions :: HM.HashMap ChainwebVersion T.Text +prettyVersions = HM.fromList . map swap $ HM.toList chainwebVersions + -- -------------------------------------------------------------------------- -- -- Test instances -- -- The code in this section must not be called in production. - --- For all production instances of Chainweb, including test nets, the --- 'ChainwebVersion' is a constant constructor that statically determines all --- parameters of that version. --- --- For testing instances, however, we require the oppportunity to uses different --- parameters. Defining a new static 'ChainwebVersion' value for each test --- setting would create too much overhead and polute the code base. Instead we --- parameterize the respective 'ChainwebVersion' constructors with for defining --- the dynamically configurable parameters. -- --- When deserializing a parameterized test 'ChainwebVersion' we need a way to --- restore the dynamic parameters. For that hash those parameters (with 15bit --- precision) and store the respective parameters in a global hash table. This --- hashtable is used only for testing and must never be used by prodcution code. --- -type TestChainwebVersionMap = HM.HashMap Word32 ChainwebVersion --- | Global map for keeping track of Test Chainweb Versions with non-static --- parameters. +-- | See `chainwebVersionId` for a complete explanation of the values in this +-- section below. -- -testChainwebVersionMap :: TVar TestChainwebVersionMap -testChainwebVersionMap = unsafePerformIO $ newTVarIO mempty -{-# NOINLINE testChainwebVersionMap #-} - -toTestChainwebVersion :: HasCallStack => ChainwebVersion -> Word32 -> Word32 -toTestChainwebVersion Testnet00 _ - = error "toTestChainwebVersion must not be called for a production isntances" -toTestChainwebVersion v i = unsafePerformIO $ do - m <- readTVarIO testChainwebVersionMap - case HM.lookup h m of - Just _ -> return () - Nothing -> atomically - $ modifyTVar' testChainwebVersionMap $ HM.insert h v - return h - where - h = i .|. (testChainwebVersionMask .&. int (hash v)) +toTestChainwebVersion :: HasCallStack => ChainwebVersion -> Word32 +toTestChainwebVersion v = + testVersionToCode v .|. graphToCode (view (chainGraph . chainGraphKnown) v) -testChainwebVersionMask :: Word32 -testChainwebVersionMask = 0x7fff0000 +-- | For the binary encoding of a `ChainGraph` within a `ChainwebVersion`. +-- +graphToCode :: KnownGraph -> Word32 +graphToCode Singleton = 0x00010000 +graphToCode Pair = 0x00020000 +graphToCode Triangle = 0x00030000 +graphToCode Peterson = 0x00040000 +graphToCode Twenty = 0x00050000 +graphToCode HoffmanSingle = 0x00060000 + +codeToGraph :: HasCallStack => Word32 -> KnownGraph +codeToGraph 0x00010000 = Singleton +codeToGraph 0x00020000 = Pair +codeToGraph 0x00030000 = Triangle +codeToGraph 0x00040000 = Peterson +codeToGraph 0x00050000 = Twenty +codeToGraph 0x00060000 = HoffmanSingle +codeToGraph _ = error "Unknown Graph Code" + +-- | Split a `Word32` representation of a `ChainwebVersion` / `ChainGraph` pair +-- into its constituent pieces. +-- +splitTestCode :: Word32 -> (Word32, Word32) +splitTestCode w = (0xf000ffff .&. w, 0x0fff0000 .&. w) + +codeToTestVersion :: HasCallStack => Word32 -> (ChainGraph -> ChainwebVersion) +codeToTestVersion 0x80000000 = Test +codeToTestVersion 0x80000001 = TestWithTime +codeToTestVersion 0x80000002 = TestWithPow +codeToTestVersion _ = error "Unknown ChainwebVersion Code" + +testVersionToCode :: ChainwebVersion -> Word32 +testVersionToCode Test{} = 0x80000000 +testVersionToCode TestWithTime{} = 0x80000001 +testVersionToCode TestWithPow{} = 0x80000002 +testVersionToCode Testnet00 = + error "Illegal ChainwebVersion passed to toTestChainwebVersion" +testVersionToCode Testnet01 = + error "Illegal ChainwebVersion passed to toTestChainwebVersion" fromTestChainwebVersionId :: HasCallStack => Word32 -> ChainwebVersion -fromTestChainwebVersionId i = case HM.lookup i m of - Nothing -> error "failed to lookup test chainweb version in testChainwebVersionMap" - Just v -> v - where - m = unsafePerformIO $ readTVarIO testChainwebVersionMap +fromTestChainwebVersionId i = + uncurry ($) . bimap codeToTestVersion (knownGraph . codeToGraph) $ splitTestCode i -- -------------------------------------------------------------------------- -- -- Basic Properties @@ -286,8 +325,8 @@ chainwebVersionGraph :: ChainwebVersion -> ChainGraph chainwebVersionGraph (Test g) = g chainwebVersionGraph (TestWithTime g) = g chainwebVersionGraph (TestWithPow g) = g -chainwebVersionGraph (Simulation g) = g chainwebVersionGraph Testnet00 = petersonChainGraph +chainwebVersionGraph Testnet01 = twentyChainGraph instance HasChainGraph ChainwebVersion where _chainGraph = chainwebVersionGraph @@ -350,3 +389,37 @@ class HasChainwebVersion a where instance HasChainwebVersion ChainwebVersion where _chainwebVersion = id {-# INLINE _chainwebVersion #-} + +chainIds :: HasChainwebVersion v => v -> HS.HashSet ChainId +chainIds = graphChainIds . _chainGraph . _chainwebVersion +{-# INLINE chainIds #-} + +mkChainId + :: MonadThrow m + => HasChainwebVersion v + => Integral i + => v + -> i + -> m ChainId +mkChainId v i = cid + <$ checkWebChainId (chainwebVersionGraph $ _chainwebVersion v) cid + where + cid = unsafeChainId (fromIntegral i) +{-# INLINE mkChainId #-} + +-- | Sometimes, in particular for testing and examples, some fixed chain id is +-- needed, but it doesn't matter which one. This function provides some valid +-- chain ids. +-- +someChainId :: HasCallStack => HasChainwebVersion v => v -> ChainId +someChainId = head . toList . chainIds + -- 'head' is guaranteed to succeed because the empty graph isn't a valid chain + -- graph. +{-# INLINE someChainId #-} + +-- | Uniformily get a random ChainId +-- +randomChainId :: HasChainwebVersion v => v -> IO ChainId +randomChainId v = (!!) (toList cs) <$> randomRIO (0, length cs - 1) + where + cs = chainIds v diff --git a/src/Chainweb/WebBlockHeaderDB.hs b/src/Chainweb/WebBlockHeaderDB.hs index c36c28e18e..868502d62e 100644 --- a/src/Chainweb/WebBlockHeaderDB.hs +++ b/src/Chainweb/WebBlockHeaderDB.hs @@ -121,10 +121,9 @@ initWebBlockHeaderDb :: ChainwebVersion -> IO WebBlockHeaderDb initWebBlockHeaderDb v = WebBlockHeaderDb - <$> itraverse (\cid _ -> initBlockHeaderDb (conf cid)) (HS.toMap $ chainIds_ g) + <$> itraverse (\cid _ -> initBlockHeaderDb (conf cid)) (HS.toMap $ chainIds v) <*> pure v where - g = _chainGraph v conf cid = Configuration (genesisBlockHeader v cid) -- | FIXME: this needs some consistency checks diff --git a/src/Data/DiGraph/FloydWarshall.hs b/src/Data/DiGraph/FloydWarshall.hs index 8ee38ea746..d1f75865ff 100644 --- a/src/Data/DiGraph/FloydWarshall.hs +++ b/src/Data/DiGraph/FloydWarshall.hs @@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -62,7 +63,7 @@ type AdjacencySets = HM.HashMap Int (HS.HashSet Int) -- set is a prefix of the natural numbers. -- fromAdjacencySets :: AdjacencySets -> DenseAdjMatrix -fromAdjacencySets g = makeArray Seq (n :. n) go +fromAdjacencySets g = makeArray Seq (Sz (n :. n)) go where n = HM.size g go (i :. j) @@ -119,7 +120,7 @@ distance (ShortestPathMatrix m) src trg diameter :: ShortestPathMatrix -> Maybe Double diameter (ShortestPathMatrix m) | M.isEmpty m = Just 0 - | otherwise = toDistance $ M.maximum $ M.map fst m + | otherwise = toDistance $ maximum' $ M.map fst m -- -------------------------------------------------------------------------- -- -- Internal @@ -153,10 +154,10 @@ floydWarshallInternal -> Array U Ix2 (Double,Int) floydWarshallInternal a = foldl' go a [0..n-1] where - (n :. _) = size a + Sz (n :. _) = size a go :: Array U Ix2 (Double, Int) -> Int -> Array U Ix2 (Double,Int) - go c k = makeArray Seq (n :. n) $ \(x :. y) -> + go c k = makeArray Seq (Sz (n :. n)) $ \(x :. y) -> let !xy = fst $! c M.! (x :. y) !xk = fst $! c M.! (x :. k) @@ -189,10 +190,10 @@ floydWarshall_ -> Array U Ix2 Double floydWarshall_ a = foldl' go a [0..n-1] where - (n :. _) = size a + Sz (n :. _) = size a go :: Array U Ix2 Double -> Int -> Array U Ix2 Double - go c k = makeArray Seq (n :. n) $ \(x :. y) -> + go c k = makeArray Seq (Sz (n :. n)) $ \(x :. y) -> let !xy = c M.! (x :. y) !xk = c M.! (x :. k) @@ -207,5 +208,5 @@ shortestPaths_ = floydWarshall_ . computeAs U . distMatrix_ diameter_ :: Array U Ix2 Int -> Maybe Natural diameter_ g | M.isEmpty g = Just 0 - | otherwise = let x = round $ M.maximum $ shortestPaths_ g + | otherwise = let x = round $ maximum' $ shortestPaths_ g in if x == round (1/0 :: Double) then Nothing else Just x diff --git a/src/Data/PQueue.hs b/src/Data/PQueue.hs index 46b4cde417..76e8aee51f 100644 --- a/src/Data/PQueue.hs +++ b/src/Data/PQueue.hs @@ -1,8 +1,5 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -- | -- Module: Data.PQueue @@ -17,17 +14,17 @@ module Data.PQueue ( PQueue , newEmptyPQueue , pQueueInsert +, pQueueInsertLimit , pQueueRemove , pQueueIsEmpty , pQueueSize ) where import Control.Concurrent.MVar -import Control.Concurrent.QSem -import Control.Exception (evaluate, onException, mask_) +import Control.Exception (evaluate) +import Control.Monad import qualified Data.Heap as H -import Data.Maybe import GHC.Generics @@ -42,36 +39,45 @@ import Numeric.Natural -- items in the queue. An item of low priority my starve in the queue if higher -- priority items are added a rate at least as high as items are removed. -- -data PQueue a = PQueue !QSem !(MVar (H.Heap a)) +data PQueue a = PQueue !(MVar ()) !(MVar (H.Heap a)) deriving (Generic) newEmptyPQueue :: IO (PQueue a) -newEmptyPQueue = PQueue <$> newQSem 0 <*> newMVar mempty +newEmptyPQueue = PQueue <$> newEmptyMVar <*> newMVar mempty pQueueInsert :: Ord a => PQueue a -> a -> IO () pQueueInsert (PQueue s q) t = modifyMVarMasked_ q $ \h -> do h' <- evaluate $ H.insert t h - signalQSem s + void $ tryPutMVar s () return h' +pQueueInsertLimit :: Ord a => PQueue a -> Natural -> a -> IO () +pQueueInsertLimit (PQueue s q) l t = modifyMVarMasked_ q $ \h -> do + h' <- evaluate $ H.insert t h + void $ tryPutMVar s () + return $ if H.size h > 2 * fromIntegral l + then H.take (fromIntegral l) h' + else h' + pQueueIsEmpty :: PQueue a -> IO Bool pQueueIsEmpty (PQueue _ q) = H.null <$> readMVar q pQueueSize :: PQueue a -> IO Natural pQueueSize (PQueue _ q) = fromIntegral . H.size <$> readMVar q --- | Blocks if the queue is empty +-- | It the queue is empty it blocks and races for new items -- pQueueRemove :: PQueue a -> IO a -pQueueRemove (PQueue s q) = mask_ $ do - waitQSem s - -- waitQSem this is interruptible, which is fine. We need to be in - -- masked state only after waitQSem succeeds. +pQueueRemove (PQueue s q) = run + where + run = do + r <- modifyMVarMasked q $ \h -> case H.uncons h of + Nothing -> return (h, Nothing) + Just (!a, !b) -> do + when (H.null b) $ void $ tryTakeMVar s + return (b, Just a) + case r of + Nothing -> takeMVar s >> run + Just x -> return x - modifyMVar q (return . (\(a,!b) -> (b, a)) . fromJust . H.uncons) - `onException` signalQSem s - -- modifyMVar is interruptible and we must ensure that we return - -- the semaphor if we receive an exception while waiting. - -- - -- the @fromJust@ here is guaranteed to succeed diff --git a/src/P2P/Node.hs b/src/P2P/Node.hs index 7a64829838..6544854da6 100644 --- a/src/P2P/Node.hs +++ b/src/P2P/Node.hs @@ -131,6 +131,13 @@ emptyP2pNodeStats = P2pNodeStats , _p2pStatsActiveMax = 0 } +_p2pStatsSessionCount :: P2pNodeStats -> Natural +_p2pStatsSessionCount s + = _p2pStatsSuccessCount s + + _p2pStatsFailureCount s + + _p2pStatsTimeoutCount s + + _p2pStatsExceptionCount s + instance Arbitrary P2pNodeStats where arbitrary = P2pNodeStats <$> arbitrary <*> arbitrary <*> arbitrary @@ -477,7 +484,8 @@ awaitSessions node = do updateKnownPeerCount node updateActiveCount node readTVar (_p2pNodeStats node) - loggFun node Info $ JsonLog stats + when (_p2pStatsSessionCount stats `mod` 250 == 0) + $ loggFun node Info $ JsonLog stats where peerDb = _p2pNodePeerDb node diff --git a/src/P2P/Peer.hs b/src/P2P/Peer.hs index 03dccc356a..da94883eea 100644 --- a/src/P2P/Peer.hs +++ b/src/P2P/Peer.hs @@ -448,9 +448,8 @@ bootstrapPeerInfos :: ChainwebVersion -> [PeerInfo] bootstrapPeerInfos Test{} = [testBootstrapPeerInfos] bootstrapPeerInfos TestWithTime{} = [testBootstrapPeerInfos] bootstrapPeerInfos TestWithPow{} = [testBootstrapPeerInfos] -bootstrapPeerInfos Simulation{} = error - $ "bootstrap peer info isn't defined for chainweb version Simulation" bootstrapPeerInfos Testnet00 = testnet00BootstrapPeerInfo +bootstrapPeerInfos Testnet01 = testnet00BootstrapPeerInfo testBootstrapPeerInfos :: PeerInfo testBootstrapPeerInfos = diff --git a/src/P2P/TaskQueue.hs b/src/P2P/TaskQueue.hs index 5164ffc2a0..9090fb2471 100644 --- a/src/P2P/TaskQueue.hs +++ b/src/P2P/TaskQueue.hs @@ -7,6 +7,7 @@ {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} @@ -148,18 +149,22 @@ session limit q logFun env = mask $ \restore -> do task <- pQueueRemove q -- check if the result variable as already been filled - tryReadIVar (_taskResult task) >>= \case - Nothing -> do - logg task Debug "run task" - flip catchAllSynchronous (retry task) $ restore $ do - r <- _taskAction task logFun env - putResult (_taskResult task) $! Right r - Just Left{} -> do - logg task Debug "task already failed" - return False - Just Right{} -> do - logg task Debug "task already succeeded" - return True + let go = tryReadIVar (_taskResult task) >>= \case + Nothing -> do + logg task Debug "run task" + flip catchAllSynchronous (retry task) $ restore $ do + r <- _taskAction task logFun env + putResult (_taskResult task) $! Right r + Just Left{} -> do + logg task Debug "task already failed" + return False + Just Right{} -> do + logg task Debug "task already succeeded" + return True + + go `catch` \(e :: SomeException) -> do + void $ retry task e + throwM e where -- reschedule a task or fail if maximum number of attempts has been reached. diff --git a/src/P2P/TaskQueue/Test.hs b/src/P2P/TaskQueue/Test.hs index aaa1b3e0ed..adb1d5dff0 100644 --- a/src/P2P/TaskQueue/Test.hs +++ b/src/P2P/TaskQueue/Test.hs @@ -20,6 +20,7 @@ module P2P.TaskQueue.Test , properties ) where +import Control.Concurrent import Control.Concurrent.Async import Control.Monad import Control.Monad.Catch @@ -47,7 +48,7 @@ newtype TestRunnerException = TestRunnerException Int instance Exception TestRunnerException testRunner :: AttemptsCount -> PQueue (Task Int a) -> IO () -testRunner limit q = forM_ [0..] $ session limit q (\_ _ -> return ()) +testRunner limit q = forM_ [0..] $ session limit q (\_ _ -> yield) -- session limit q (\_ m -> T.putStrLn $ logText m) -- -------------------------------------------------------------------------- -- @@ -63,15 +64,27 @@ test1 n = do results <- traverse awaitTask tasks return $ results == [0..n] -test2 :: (Positive Int) -> IO Bool -test2 (Positive n_) = do +test2a :: (Positive Int) -> IO Bool +test2a (Positive n_) = do tasks <- forM [0..n] $ \i -> newTask (TaskId $ sshow i) (Priority (n - i)) $ \_ -> return @_ @Int q <- newEmptyPQueue withAsync (testRunner 3 q) $ \_ -> do traverse_ (pQueueInsert q) tasks results <- traverse awaitTask tasks - return $ results /= [0..n] && L.sort results == [0..n] + return $ results /= [0..n] + where + n = n_ + 10 + +test2b :: (Positive Int) -> IO Bool +test2b (Positive n_) = do + tasks <- forM [0..n] $ \i -> + newTask (TaskId $ sshow i) (Priority (n - i)) $ \_ -> return @_ @Int + q <- newEmptyPQueue + withAsync (testRunner 3 q) $ \_ -> do + traverse_ (pQueueInsert q) tasks + results <- traverse awaitTask tasks + return $ L.sort results == [0..n] where n = n_ + 10 @@ -115,7 +128,8 @@ test5 (Positive n) (Positive m) (Positive a) properties :: [(String, Property)] properties = [ ("TaskQueue.Test.test1", property $ monadicIO . run . test1) - , ("TaskQueue.Test.test2", property $ monadicIO . run . test2) + , ("TaskQueue.Test.test2a", property $ monadicIO . run . test2a) + , ("TaskQueue.Test.test2b", property $ monadicIO . run . test2b) , ("TaskQueue.Test.test3", property $ monadicIO . run . test3) , ("TaskQueue.Test.test4", property $ monadicIO . run . test4) , ("TaskQueue.Test.test5", property $ \a b -> monadicIO . run . test5 a b) diff --git a/stack.yaml b/stack.yaml index a1217f4ef1..f579833369 100644 --- a/stack.yaml +++ b/stack.yaml @@ -17,11 +17,13 @@ extra-deps: - hspec-core-2.5.8 - hspec-discover-2.5.8 - loglevel-0.1.0.0@sha256:951338d262fb734cc2f06a6ee9fddb7ea998a71a5098011d864f038f4ec7ac2a,1256 + - massiv-0.3.0.0 - paths-0.2.0.0@sha256:85e77985968860365cdb2074515b339863344ca0d28baa879baf4105f93e87cc,2628 # QuickCheck-2.12 - QuickCheck-2.12.6.1 - QuickCheck-GenT-0.2.0 - sbv-8.1 + - scheduler-1.0.0@sha256:7f5ddfff0d911b089014f0d7668fe7380c65d94630f204f943181e04815b14ed - strict-tuple-0.1.2@sha256:546cce0dae83a49f805749b3cdee6ccdbab425c58d78731bbe126dc0a758b80f - tasty-1.2 - token-bucket-0.1.0.1@sha256:ef80a31e7f4f794e3686eb405a49afc663535dd3a11c012a002a7bacce897da6 diff --git a/test/Chainweb/Test/BlockHeader/Genesis.hs b/test/Chainweb/Test/BlockHeader/Genesis.hs index 3d6ff67513..618f229f04 100644 --- a/test/Chainweb/Test/BlockHeader/Genesis.hs +++ b/test/Chainweb/Test/BlockHeader/Genesis.hs @@ -13,9 +13,10 @@ module Chainweb.Test.BlockHeader.Genesis import Control.Monad (zipWithM_) +import Data.Foldable import Data.Function (on) import qualified Data.HashMap.Strict as HM -import Data.List (sortBy) +import Data.List (sort, sortBy) import Test.Tasty import Test.Tasty.HUnit @@ -24,9 +25,8 @@ import Test.Tasty.HUnit import Chainweb.BlockHeader (BlockHeader(..), Nonce(..)) import Chainweb.BlockHeader.Genesis -import Chainweb.ChainId (unsafeChainId) import Chainweb.Miner.Genesis (mineGenesis) -import Chainweb.Version (ChainwebVersion(..)) +import Chainweb.Version (ChainwebVersion(..), chainIds) --- @@ -48,6 +48,7 @@ allBlocksParse = map _blockHeight testnet00Chains @?= replicate 10 0 -- what was hardcoded? -- regeneration :: ChainwebVersion -> [BlockHeader] -> Assertion -regeneration v bs = zipWithM_ (\cid chain -> mine cid @?= chain) [0..] bs +regeneration v bs = zipWithM_ (\cid chain -> mine cid @?= chain) cids bs where - mine c = mineGenesis v (unsafeChainId c) (genesisTime v) (Nonce 0) + cids = sort $ toList $ chainIds v + mine c = mineGenesis v c (genesisTime v) (Nonce 0) diff --git a/test/Chainweb/Test/BlockHeaderDB.hs b/test/Chainweb/Test/BlockHeaderDB.hs index 8eb1bc8e49..18bb291f5e 100644 --- a/test/Chainweb/Test/BlockHeaderDB.hs +++ b/test/Chainweb/Test/BlockHeaderDB.hs @@ -13,7 +13,6 @@ module Chainweb.Test.BlockHeaderDB ( tests ) where - import Data.Semigroup (Min(..)) import qualified Streaming.Prelude as S @@ -23,19 +22,16 @@ import Test.Tasty.HUnit -- internal modules - import Chainweb.BlockHeader (BlockHeader(..)) import Chainweb.BlockHeaderDB -import Chainweb.ChainId (ChainId, unsafeChainId) import Chainweb.Test.TreeDB (RunStyle(..), treeDbInvariants) -import Chainweb.Test.Utils (insertN, toyBlockHeaderDb, withDB) +import Chainweb.Test.Utils (insertN, toyBlockHeaderDb, withToyDB, toyChainId) import Chainweb.TreeDB - tests :: TestTree tests = testGroup "Unit Tests" [ testGroup "Basic Interaction" - [ testCase "Initialization + Shutdown" $ toyBlockHeaderDb chainId0 >>= closeBlockHeaderDb . snd + [ testCase "Initialization + Shutdown" $ toyBlockHeaderDb toyChainId >>= closeBlockHeaderDb . snd ] , testGroup "Insertion" [ testCase "10 Insertions" insertItems @@ -54,20 +50,17 @@ tests = testGroup "Unit Tests" withDb :: BlockHeader -> (BlockHeaderDb -> IO Bool) -> IO Bool withDb h f = initBlockHeaderDb (Configuration h) >>= \db -> f db <* closeBlockHeaderDb db -chainId0 :: ChainId -chainId0 = unsafeChainId 0 - insertItems :: Assertion -insertItems = withDB chainId0 $ \g db -> insertN 10 g db +insertItems = withToyDB toyChainId $ \g db -> insertN 10 g db correctHeight :: Assertion -correctHeight = withDB chainId0 $ \g db -> do +correctHeight = withToyDB toyChainId $ \g db -> do maxRank db >>= \r -> r @?= 0 insertN 10 g db maxRank db >>= \r -> r @?= 10 copyTest :: Assertion -copyTest = withDB chainId0 $ \g db -> do +copyTest = withToyDB toyChainId $ \g db -> do db' <- copy db maxRank db >>= \r -> r @?= 0 maxRank db' >>= \r -> r @?= 0 @@ -79,13 +72,13 @@ copyTest = withDB chainId0 $ \g db -> do maxRank db' >>= \r -> r @?= 10 rankFiltering :: Assertion -rankFiltering = withDB chainId0 $ \g db -> do +rankFiltering = withToyDB toyChainId $ \g db -> do insertN 100 g db l <- S.length_ $ entries db Nothing Nothing (Just . MinRank $ Min 90) Nothing l @?= 11 children :: Assertion -children = withDB chainId0 $ \g db -> do +children = withToyDB toyChainId $ \g db -> do insertN 5 g db l <- S.length_ $ childrenKeys db (_blockHash g) l @?= 1 diff --git a/test/Chainweb/Test/CutDB.hs b/test/Chainweb/Test/CutDB.hs index bd1a4efd9d..edcba6642e 100644 --- a/test/Chainweb/Test/CutDB.hs +++ b/test/Chainweb/Test/CutDB.hs @@ -46,6 +46,7 @@ import Chainweb.BlockHeader import Chainweb.ChainId import Chainweb.Cut import Chainweb.Cut.CutHashes +import Chainweb.Cut.Test import Chainweb.CutDB import Chainweb.NodeId import Chainweb.Pact.Types diff --git a/test/Chainweb/Test/DiGraph.hs b/test/Chainweb/Test/DiGraph.hs index 410f9792ba..8273bf19cd 100644 --- a/test/Chainweb/Test/DiGraph.hs +++ b/test/Chainweb/Test/DiGraph.hs @@ -236,7 +236,7 @@ instance (KnownNat n) => Arbitrary (Gnm n) where -- All entries of the result matrix are either whole numbers or 'Infinity'. -- fglShortestPaths :: G.Graph g => g Int Int -> Array U Ix2 Double -fglShortestPaths g = makeArray Seq (n :. n) $ \(i :. j) -> +fglShortestPaths g = makeArray Seq (M.Sz (n :. n)) $ \(i :. j) -> maybe (1/0) realToFrac $ G.getDistance j (sp i) where sp i = G.spTree i g @@ -245,7 +245,7 @@ fglShortestPaths g = makeArray Seq (n :. n) $ \(i :. j) -> fglDiameter :: G.Graph g => g Int Int -> Maybe Natural fglDiameter g = if M.isEmpty sps then Just 0 - else let x = round $ M.maximum sps + else let x = round $ M.maximum' sps in if x == round (1/0 :: Double) then Nothing else Just x where sps = fglShortestPaths g diff --git a/test/Chainweb/Test/Mempool/RestAPI.hs b/test/Chainweb/Test/Mempool/RestAPI.hs index bf1243e699..5b528f5c09 100644 --- a/test/Chainweb/Test/Mempool/RestAPI.hs +++ b/test/Chainweb/Test/Mempool/RestAPI.hs @@ -4,7 +4,6 @@ module Chainweb.Test.Mempool.RestAPI (tests) where import Control.Concurrent import Control.Concurrent.STM import Control.Exception -import Data.Foldable import qualified Data.Pool as Pool import qualified Network.HTTP.Client as HTTP import Servant.Client (BaseUrl(..), Scheme(..), mkClientEnv) @@ -58,7 +57,7 @@ newTestServer inMemCfg = mask_ $ do blocksizeLimit = InMem._inmemTxBlockSizeLimit inMemCfg txcfg = InMem._inmemTxCfg inMemCfg host = "127.0.0.1" - chain = head $ toList $ chainIds_ singletonChainGraph + chain = someChainId version mkApp mp = chainwebApplication version (serverMempools [(chain, mp)]) mkEnv port = do mgrSettings <- certificateCacheManagerSettings TlsInsecure Nothing diff --git a/test/Chainweb/Test/Orphans/Internal.hs b/test/Chainweb/Test/Orphans/Internal.hs index 2372f5498d..c929e4b838 100644 --- a/test/Chainweb/Test/Orphans/Internal.hs +++ b/test/Chainweb/Test/Orphans/Internal.hs @@ -58,8 +58,6 @@ instance Arbitrary ChainwebVersion where , TestWithTime petersonChainGraph , TestWithPow singletonChainGraph , TestWithPow petersonChainGraph - , Simulation singletonChainGraph - , Simulation petersonChainGraph , Testnet00 ] @@ -114,11 +112,11 @@ instance Arbitrary BlockHeader where arbitrary = fromLog . newMerkleLog <$> entries where entries - = liftA2 (:+:) arbitrary + = liftA2 (:+:) (Nonce <$> chooseAny) + $ liftA2 (:+:) arbitrary $ liftA2 (:+:) arbitrary $ liftA2 (:+:) arbitrary $ liftA2 (:+:) arbitrary - $ liftA2 (:+:) (Nonce <$> chooseAny) $ liftA2 (:+:) (pure (unsafeChainId 0)) $ liftA2 (:+:) arbitrary $ liftA2 (:+:) (BlockHeight . int @Int . getPositive <$> arbitrary) diff --git a/test/Chainweb/Test/P2P/Peer/BootstrapConfig.hs b/test/Chainweb/Test/P2P/Peer/BootstrapConfig.hs index 0beb97efe7..72de99fe0e 100644 --- a/test/Chainweb/Test/P2P/Peer/BootstrapConfig.hs +++ b/test/Chainweb/Test/P2P/Peer/BootstrapConfig.hs @@ -37,10 +37,10 @@ bootstrapPeerConfig :: ChainwebVersion -> [PeerConfig] bootstrapPeerConfig v@Test{} = testBootstrapPeerConfig v bootstrapPeerConfig v@TestWithTime{} = testBootstrapPeerConfig v bootstrapPeerConfig v@TestWithPow{} = testBootstrapPeerConfig v -bootstrapPeerConfig Simulation{} = error - $ "bootstrap peer config isn't defined for chainweb version Simulation" bootstrapPeerConfig Testnet00 = error $ "bootstrap peer config isn't defined for chainweb version Testnet00" +bootstrapPeerConfig Testnet01 = error + $ "bootstrap peer config isn't defined for chainweb version Testnet01" testBootstrapPeerConfig :: ChainwebVersion -> [PeerConfig] testBootstrapPeerConfig v = @@ -65,10 +65,10 @@ bootstrapCertificate :: ChainwebVersion -> X509CertPem bootstrapCertificate Test{} = testBootstrapCertificate bootstrapCertificate TestWithTime{} = testBootstrapCertificate bootstrapCertificate TestWithPow{} = testBootstrapCertificate -bootstrapCertificate Simulation{} = error - $ "bootstrap certificate isn't defined for chainweb version Simulation" -bootstrapCertificate Testnet00 = error +bootstrapCertificate Testnet00 = error $ "bootstrap certificate isn't defined for chainweb version Testnet00" +bootstrapCertificate Testnet01 = error + $ "bootstrap certificate isn't defined for chainweb version Testnet01" -- | The test certificate is also stored in the file -- @./scripts/scripts/test-bootstrap-node.config@. @@ -123,10 +123,10 @@ bootstrapKey :: ChainwebVersion -> X509KeyPem bootstrapKey Test{} = testBootstrapKey bootstrapKey TestWithTime{} = testBootstrapKey bootstrapKey TestWithPow{} = testBootstrapKey -bootstrapKey Simulation{} = error - $ "bootstrap key isn't defined for chainweb version Simulation" bootstrapKey Testnet00 = error $ "bootstrap key isn't defined for chainweb version Testnet00" +bootstrapKey Testnet01 = error + $ "bootstrap key isn't defined for chainweb version Testnet01" -- | This is only defined for non-public Test instances -- diff --git a/test/Chainweb/Test/Pact/PactExec.hs b/test/Chainweb/Test/Pact/PactExec.hs index 5449cf72a5..2185a8a4a5 100644 --- a/test/Chainweb/Test/Pact/PactExec.hs +++ b/test/Chainweb/Test/Pact/PactExec.hs @@ -45,16 +45,17 @@ import Pact.Types.Logger import qualified Pact.Types.Runtime as P import Pact.Types.Server -import Chainweb.Graph (petersonChainGraph) import Chainweb.Pact.Backend.InMemoryCheckpointer import Chainweb.Pact.Backend.SQLiteCheckpointer import Chainweb.Pact.PactService import Chainweb.Pact.Types import Chainweb.Test.Pact.Utils -import Chainweb.Version (ChainwebVersion(..)) -import Chainweb.ChainId +import Chainweb.Version (ChainwebVersion(..), someChainId) import Chainweb.BlockHash +testVersion :: ChainwebVersion +testVersion = Testnet00 + tests :: IO TestTree tests = do setup <- pactTestSetup @@ -65,7 +66,7 @@ pactTestSetup :: IO PactTestSetup pactTestSetup = do let loggers = alwaysLog let logger = newLogger loggers $ LogName "PactService" - let pactCfg = pactDbConfig (Test petersonChainGraph) + let pactCfg = pactDbConfig testVersion let cmdConfig = toCommandConfig pactCfg let gasLimit = fromMaybe 0 (_ccGasLimit cmdConfig) let gasRate = fromMaybe 0 (_ccGasRate cmdConfig) @@ -91,7 +92,8 @@ pactTestSetup = do pactExecTests :: PactTestSetup -> IO [TestTree] pactExecTests (PactTestSetup env st) = do let pss = PactServiceState st Nothing - fst <$> runStateT (runReaderT (initialPayloadState Testnet00 (unsafeChainId 0) >> execTests) env) pss + cid = someChainId testVersion + fst <$> runStateT (runReaderT (initialPayloadState testVersion cid >> execTests) env) pss execTests :: PactServiceM [TestTree] execTests = do diff --git a/test/Chainweb/Test/Pact/PactInProcApi.hs b/test/Chainweb/Test/Pact/PactInProcApi.hs index 20d9fdb11b..da07b88529 100644 --- a/test/Chainweb/Test/Pact/PactInProcApi.hs +++ b/test/Chainweb/Test/Pact/PactInProcApi.hs @@ -23,11 +23,12 @@ import System.FilePath import System.IO.Extra import System.LogLevel -import Test.Tasty.HUnit import Test.Tasty import Test.Tasty.Golden +import Test.Tasty.HUnit import Chainweb.BlockHeader +import Chainweb.BlockHeader.Genesis import Chainweb.ChainId import Chainweb.Logger import Chainweb.Pact.Service.BlockValidation @@ -36,10 +37,11 @@ import Chainweb.Pact.Service.Types import Chainweb.Pact.Types import Chainweb.Payload import Chainweb.Test.Pact.Utils -import Chainweb.Version (ChainwebVersion(..)) -import Chainweb.BlockHeader.Genesis import Chainweb.Transaction +import Chainweb.Version (ChainwebVersion(..), someChainId) +testVersion :: ChainwebVersion +testVersion = Testnet00 tests :: IO TestTree tests = do @@ -50,15 +52,15 @@ tests = do pactApiTest :: IO [TestTree] pactApiTest = do let logger = genericLogger Warn T.putStrLn - cid = unsafeChainId 0 + cid = someChainId testVersion mv <- newEmptyMVar -- Init for tests - withPactService' Testnet00 cid logger testMemPoolAccess mv $ \reqQ -> do - let headers = V.fromList $ getBlockHeaders 2 + withPactService' testVersion cid logger testMemPoolAccess mv $ \reqQ -> do + let headers = V.fromList $ getBlockHeaders cid 2 -- newBlock test - let genesisHeader = genesisBlockHeader Testnet00 cid + let genesisHeader = genesisBlockHeader testVersion cid respVar0 <- newBlock noMiner genesisHeader reqQ mvr <- takeMVar respVar0 -- wait for response plwo <- case mvr of @@ -93,12 +95,12 @@ pactApiTest = do pactEmptyBlockTest :: IO TestTree pactEmptyBlockTest = do let logger = genericLogger Warn T.putStrLn - cid = unsafeChainId 0 + cid = someChainId testVersion mv <- newEmptyMVar - withPactService' Testnet00 cid logger testEmptyMemPool mv $ \reqQ -> do - let genesisHeader = genesisBlockHeader Testnet00 cid + withPactService' testVersion cid logger testEmptyMemPool mv $ \reqQ -> do + let genesisHeader = genesisBlockHeader testVersion cid respVar0 <- newBlock noMiner genesisHeader reqQ mvr <- takeMVar respVar0 -- wait for response plwo <- case mvr of @@ -171,11 +173,10 @@ checkBlockTransactions filePrefix bTrans = do return $ testGroup "BlockTransactions" $ ttTrans : [ttTransHash] -getBlockHeaders :: Int -> [BlockHeader] -getBlockHeaders n = do - let gbh0 = genesis - let after0s = take (n - 1) $ testBlockHeaders gbh0 - gbh0 : after0s +getBlockHeaders :: ChainId -> Int -> [BlockHeader] +getBlockHeaders cid n = gbh0 : take (n - 1) (testBlockHeaders gbh0) + where + gbh0 = genesisBlockHeader testVersion cid testMemPoolAccess :: MemPoolAccess testMemPoolAccess _bHeight _bHash = do diff --git a/test/Chainweb/Test/Pact/RemotePactTest.hs b/test/Chainweb/Test/Pact/RemotePactTest.hs index 496a77ac00..6bdf637a5e 100644 --- a/test/Chainweb/Test/Pact/RemotePactTest.hs +++ b/test/Chainweb/Test/Pact/RemotePactTest.hs @@ -1,5 +1,7 @@ {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE QuasiQuotes #-} -- | @@ -22,17 +24,25 @@ import Control.Monad import qualified Data.Aeson as A import qualified Data.ByteString as BS import qualified Data.HashMap.Strict as HM +import Data.Int import Data.Maybe import Data.Proxy import Data.Streaming.Network (HostPreference) import Data.String.Conv (toS) +import Data.Text (Text) +import Data.Vector (Vector) +import qualified Data.Vector as V import Network.HTTP.Client.TLS as HTTP import Network.Connection as HTTP import Numeric.Natural +import Prelude hiding (lookup) + +import Servant.API import Servant.Client + import System.FilePath import System.LogLevel import System.Time.Extra @@ -44,14 +54,19 @@ import Test.Tasty.Golden import Text.RawString.QQ(r) import Pact.Types.API +import Pact.Types.Command +import Pact.Types.Util -- internal modules import Chainweb.Chainweb +import Chainweb.ChainId import Chainweb.Chainweb.PeerResources import Chainweb.Graph import Chainweb.HostAddress import Chainweb.Logger +import Chainweb.Mempool.Mempool +import Chainweb.Mempool.RestAPI.Client import Chainweb.Miner.Config import Chainweb.NodeId import Chainweb.Pact.RestAPI @@ -64,63 +79,90 @@ import Chainweb.Version import P2P.Node.Configuration import P2P.Peer -apiSend :: SubmitBatch -> ClientM RequestKeys -apiSend = client (Proxy :: Proxy SendApi) - -apiPoll :: Poll -> ClientM PollResponses -apiPoll = client (Proxy :: Proxy PollApi) - nNodes :: Natural nNodes = 1 +version :: ChainwebVersion +version = TestWithTime petersonChainGraph + +cid :: ChainId +cid = either (error . sshow) id $ mkChainId version (0 :: Int) + tests :: IO TestTree tests = do peerInfoVar <- newEmptyMVar - let cwVersion = TestWithTime petersonChainGraph - theAsync <- async $ runTestNodes Warn cwVersion nNodes Nothing peerInfoVar + theAsync <- async $ runTestNodes Warn version nNodes Nothing peerInfoVar link theAsync newPeerInfo <- readMVar peerInfoVar let thePort = _hostAddressPort (_peerAddr newPeerInfo) + let cmds = apiCmds version cid + let cwBaseUrl = getCwBaseUrl thePort + cwEnv <- getClientEnv cwBaseUrl + (tt0, rks) <- testSend cmds cwEnv - env <- getClientEnv thePort cwVersion - tts <- sendTest env - return $ testGroup "PactRemoteTest" tts + tt1 <- testPoll cmds cwEnv rks + let tConfig = mempoolTxConfig noopMempool + let mPool = toMempool version cid tConfig 10000 cwEnv :: MempoolBackend ChainwebTransaction + tt2 <- testMPValidated mPool rks -sendTest :: ClientEnv -> IO [TestTree] -sendTest env = do + return $ testGroup "PactRemoteTest" $ tt0 : (tt1 : [tt2]) + +testSend :: PactTestApiCmds -> ClientEnv -> IO (TestTree, RequestKeys) +testSend cmds env = do let msb = decodeStrictOrThrow $ toS escapedCmd case msb of Nothing -> assertFailure "decoding command string failed" Just sb -> do - result <- sendWithRetry env sb + result <- sendWithRetry cmds env sb case result of Left e -> assertFailure (show e) Right rks -> do tt0 <- checkRequestKeys "command-0" rks - response <- pollWithRetry env rks - case response of - Left e -> assertFailure (show e) - Right rsp -> do - tt1 <- checkResponse "command-0" rks rsp - return (tt0 : [tt1]) - -getClientEnv :: Port -> ChainwebVersion -> IO ClientEnv -getClientEnv thePort cwVersion = do + return (tt0, rks) + +testPoll :: PactTestApiCmds -> ClientEnv -> RequestKeys -> IO TestTree +testPoll cmds env rks = do + response <- pollWithRetry cmds env rks + case response of + Left e -> assertFailure (show e) + Right rsp -> checkResponse "command-0" rks rsp + +testMPValidated + :: MempoolBackend ChainwebTransaction + -> RequestKeys + -> IO TestTree +testMPValidated mPool rks = do + let txHashes = V.fromList $ TransactionHash . unHash . unRequestKey <$> _rkRequestKeys rks + responses <- mempoolLookup mPool txHashes + checkValidated responses + +checkValidated :: Vector (LookupResult ChainwebTransaction) -> IO TestTree +checkValidated results = do + when (null results) + $ assertFailure "No results returned from mempool's lookupTransaction" + return $ testCase "allTransactionsValidated" $ + assertBool "At least one transaction was not validated" $ V.all f results + where + f (Validated _) = True + f Confirmed = True + f _ = False + +getClientEnv :: BaseUrl -> IO ClientEnv +getClientEnv url = do let mgrSettings = HTTP.mkManagerSettings (HTTP.TLSSettingsSimple True False False) Nothing mgr <- HTTP.newTlsManagerWith mgrSettings - let url = testUrl thePort cwVersion "0.0" 8 return $ mkClientEnv mgr url maxSendRetries :: Int maxSendRetries = 30 -- | To allow time for node to startup, retry a number of times -sendWithRetry :: ClientEnv -> SubmitBatch -> IO (Either ServantError RequestKeys) -sendWithRetry env sb = go maxSendRetries +sendWithRetry :: PactTestApiCmds -> ClientEnv -> SubmitBatch -> IO (Either ServantError RequestKeys) +sendWithRetry cmds env sb = go maxSendRetries where go retries = do - result <- runClientM (apiSend sb) env + result <- runClientM (sendApiCmd cmds sb) env case result of Left _ -> if retries == 0 then do @@ -137,13 +179,13 @@ maxPollRetries :: Int maxPollRetries = 30 -- | To allow time for node to startup, retry a number of times -pollWithRetry :: ClientEnv -> RequestKeys -> IO (Either ServantError PollResponses) -pollWithRetry env rks = do +pollWithRetry :: PactTestApiCmds -> ClientEnv -> RequestKeys -> IO (Either ServantError PollResponses) +pollWithRetry cmds env rks = do sleep 3 go maxPollRetries where go retries = do - result <- runClientM (apiPoll (Poll (_rkRequestKeys rks))) env + result <- runClientM (pollApiCmd cmds (Poll (_rkRequestKeys rks))) env case result of Left _ -> if retries == 0 then do @@ -156,6 +198,9 @@ pollWithRetry env rks = do putStrLn $ "poll succeeded after " ++ show (maxSendRetries - retries) ++ " retries" return result +maxMemPoolRetries :: Int +maxMemPoolRetries = 30 + checkRequestKeys :: FilePath -> RequestKeys -> IO TestTree checkRequestKeys filePrefix rks = do let fp = filePrefix ++ "-expected-rks.txt" @@ -165,28 +210,44 @@ checkRequestKeys filePrefix rks = do checkResponse :: FilePath -> RequestKeys -> PollResponses -> IO TestTree checkResponse filePrefix rks (PollResponses theMap) = do let fp = filePrefix ++ "-expected-resp.txt" - - let mays = map (\x -> HM.lookup x theMap) (_rkRequestKeys rks) + let mays = map (`HM.lookup` theMap) (_rkRequestKeys rks) let values = _arResult <$> catMaybes mays let bsResponse = return $ toS $ foldMap A.encode values return $ goldenVsString (takeBaseName fp) (testPactFilesDir ++ fp) bsResponse -testUrl :: Port -> ChainwebVersion -> String -> Int -> BaseUrl -testUrl thePort v release chainNum = BaseUrl +getCwBaseUrl :: Port -> BaseUrl +getCwBaseUrl thePort = BaseUrl { baseUrlScheme = Https , baseUrlHost = "127.0.0.1" , baseUrlPort = fromIntegral thePort - , baseUrlPath = "chainweb/" - ++ release ++ "/" - ++ toS (chainwebVersionToText v) ++ "/" - ++ "chain/" - ++ show chainNum ++ "/" - ++ "pact" } + , baseUrlPath = "" } escapedCmd :: BS.ByteString escapedCmd = [r|{"cmds":[{"hash":"d0613e7a16bf938f45b97aa831b0cc04da485140bec11cc8954e0509ea65d823472b1e683fa2950da1766cbe7fae9de8ed416e80b0ccbf12bfa6549eab89aeb6","sigs":[{"addr":"368820f80c324bbc7c2b0610688a7da43e39f91d118732671cd9c7500ff43cca","sig":"71cdedd5b1305881b1fd3d4ac2009cb247d0ebb55d1d122a7f92586828a1ed079e6afc9e8b3f75fa25fba84398eeea6cc3b92949a315420431584ba372605d07","scheme":"ED25519","pubKey":"368820f80c324bbc7c2b0610688a7da43e39f91d118732671cd9c7500ff43cca"}],"cmd":"{\"payload\":{\"exec\":{\"data\":null,\"code\":\"(+ 1 2)\"}},\"meta\":{\"gasLimit\":100,\"chainId\":\"0\",\"gasPrice\":1.0e-4,\"sender\":\"sender00\"},\"nonce\":\"2019-03-29 20:35:45.012384811 UTC\"}"}]}|] +type PactClientApi + = (SubmitBatch -> ClientM RequestKeys) + :<|> ((Poll -> ClientM PollResponses) + :<|> ((ListenerRequest -> ClientM ApiResult) + :<|> (Command Text -> ClientM (CommandSuccess A.Value)))) + +generatePactApi :: ChainwebVersion -> ChainId -> PactClientApi +generatePactApi cwVersion chainid = + case someChainwebVersionVal cwVersion of + SomeChainwebVersionT (_ :: Proxy cv) -> + case someChainIdVal chainid of + SomeChainIdT (_ :: Proxy cid) -> client (Proxy :: Proxy (PactApi cv cid)) + +apiCmds :: ChainwebVersion -> ChainId -> PactTestApiCmds +apiCmds cwVersion theChainId = + let sendCmd :<|> pollCmd :<|> _ :<|> _ = generatePactApi cwVersion theChainId + in PactTestApiCmds sendCmd pollCmd + +data PactTestApiCmds = PactTestApiCmds + { sendApiCmd :: SubmitBatch -> ClientM RequestKeys + , pollApiCmd :: Poll -> ClientM PollResponses } + ---------------------------------------------------------------------------------------------------- -- test node(s), config, etc. for this test ---------------------------------------------------------------------------------------------------- diff --git a/test/Chainweb/Test/Pact/SPV.hs b/test/Chainweb/Test/Pact/SPV.hs index 9e8f95e42b..fa16caee9c 100644 --- a/test/Chainweb/Test/Pact/SPV.hs +++ b/test/Chainweb/Test/Pact/SPV.hs @@ -82,7 +82,7 @@ testCaseStepsN name n t = testGroup name $ fmap steps [1..n] -- targetChain :: Cut -> BlockHeader -> IO ChainId targetChain c srcBlock = do - cids <- generate (shuffle $ toList $ chainIds_ graph) + cids <- generate (shuffle $ toList $ chainIds c) go cids where graph = _chainGraph c @@ -138,7 +138,7 @@ withPactSetup cdb f = do pure (cpe,st) initCC = runRST $ - initialPayloadState Testnet00 (unsafeChainId 0) + initialPayloadState Testnet00 $ someChainId Testnet00 createCoinCmd :: Transaction -> IO (ExecMsg ParsedCode) createCoinCmd tx = buildExecParsedCode spvData diff --git a/test/Chainweb/Test/Pact/Utils.hs b/test/Chainweb/Test/Pact/Utils.hs index d9d1b7fc10..9fe19b6360 100644 --- a/test/Chainweb/Test/Pact/Utils.hs +++ b/test/Chainweb/Test/Pact/Utils.hs @@ -10,8 +10,6 @@ module Chainweb.Test.Pact.Utils ( -- * test data someED25519Pair -, genesis -, chainId0 , testPactFilesDir , testKeyPairs -- * helper functions @@ -45,9 +43,6 @@ import Pact.Parse (ParsedDecimal(..),ParsedInteger(..)) -- internal chainweb modules -import Chainweb.BlockHeader (BlockHeader) -import Chainweb.ChainId (ChainId, unsafeChainId) -import Chainweb.Test.Utils (toyGenesis) import Chainweb.Transaction import Chainweb.Utils @@ -71,12 +66,6 @@ someED25519Pair = , ED25519 ) -genesis :: BlockHeader -genesis = toyGenesis chainId0 - -chainId0 :: ChainId -chainId0 = unsafeChainId 0 - ------------------------------------------------------------------------------ -- helper logic ------------------------------------------------------------------------------ diff --git a/test/Chainweb/Test/RestAPI.hs b/test/Chainweb/Test/RestAPI.hs index 1e97dd0f79..48467f6390 100644 --- a/test/Chainweb/Test/RestAPI.hs +++ b/test/Chainweb/Test/RestAPI.hs @@ -113,7 +113,7 @@ simpleSessionTests :: Bool -> ChainwebVersion -> TestTree simpleSessionTests tls version = withBlockHeaderDbsServer tls version (testBlockHeaderDbs version) (return noMempool) $ \env -> testGroup "client session tests" - $ simpleClientSession env <$> toList (chainIds_ $ _chainGraph version) + $ simpleClientSession env <$> toList (chainIds version) simpleClientSession :: IO TestClientEnv_ -> ChainId -> TestTree simpleClientSession envIO cid = @@ -223,10 +223,14 @@ putExisting = simpleTest "put existing block header" isRight $ \h0 -> putOnWrongChain :: IO TestClientEnv_ -> TestTree putOnWrongChain = simpleTest "put on wrong chain fails" (isErrorCode 400) - $ \h0 -> headerPutClient (_chainwebVersion h0) (_chainId h0) - . head - . testBlockHeadersWithNonce (Nonce 2) - $ genesisBlockHeader (Test petersonChainGraph) (unsafeChainId 1) + $ \h0 -> do + cid <- mkChainId v (1 :: Int) + headerPutClient (_chainwebVersion h0) (_chainId h0) + . head + . testBlockHeadersWithNonce (Nonce 2) + $ genesisBlockHeader v cid + where + v = Test petersonChainGraph putMissingParent :: IO TestClientEnv_ -> TestTree putMissingParent = simpleTest "put missing parent" (isErrorCode 400) $ \h0 -> diff --git a/test/Chainweb/Test/SPV.hs b/test/Chainweb/Test/SPV.hs index 2f9933db6b..d00706bf8c 100644 --- a/test/Chainweb/Test/SPV.hs +++ b/test/Chainweb/Test/SPV.hs @@ -83,7 +83,7 @@ testCaseStepsN name n test = testGroup name $ flip map [1..n] $ \i -> -- targetChain :: Cut -> BlockHeader -> IO ChainId targetChain c srcBlock = do - cids <- generate (shuffle $ toList $ chainIds_ graph) + cids <- generate (shuffle $ toList $ chainIds c) go cids where graph = _chainGraph c @@ -189,9 +189,8 @@ apiTests tls v = withTestPayloadResource v 100 (\_ _ -> return ()) $ \dbsIO -> testCaseStepsN "spv api tests (with tls)" 10 (txApiTests env) ] where - cids = toList (chainIds_ graph) + cids = toList $ chainIds v payloadDbs db = (, db) <$> cids - graph = _chainGraph v txApiTests :: IO TestClientEnv_ -> Step -> IO () txApiTests envIO step = do diff --git a/test/Chainweb/Test/Store/Git.hs b/test/Chainweb/Test/Store/Git.hs index 2793f4664e..063cbc96b5 100644 --- a/test/Chainweb/Test/Store/Git.hs +++ b/test/Chainweb/Test/Store/Git.hs @@ -13,20 +13,16 @@ import Test.Tasty.HUnit -- internal modules import Chainweb.BlockHeader (BlockHeader(..), testBlockHeaders) -import Chainweb.ChainId import Chainweb.Store.Git import Chainweb.Store.Git.Internal import Chainweb.Test.TreeDB -import Chainweb.Test.Utils (toyGenesis) +import Chainweb.Test.Utils (toyGenesis, toyChainId) import Chainweb.Utils (withTempDir) --- -chainId0 :: ChainId -chainId0 = unsafeChainId 0 - genesis :: BlockHeader -genesis = toyGenesis chainId0 +genesis = toyGenesis toyChainId chainLen :: Int chainLen = 100 diff --git a/test/Chainweb/Test/TreeDB/Persistence.hs b/test/Chainweb/Test/TreeDB/Persistence.hs index 43b6576422..bed33155cc 100644 --- a/test/Chainweb/Test/TreeDB/Persistence.hs +++ b/test/Chainweb/Test/TreeDB/Persistence.hs @@ -28,16 +28,12 @@ import Test.Tasty.HUnit -- internal modules -import Chainweb.ChainId (ChainId, unsafeChainId) -import Chainweb.Test.Utils (insertN, withDB) +import Chainweb.Test.Utils (insertN, withToyDB, toyChainId) import Chainweb.TreeDB import Chainweb.TreeDB.Persist (fileEntries, persist) --- -chainId0 :: ChainId -chainId0 = unsafeChainId 0 - tests :: TestTree tests = testGroup "Persistence" [ testGroup "Encoding round-trips" @@ -50,7 +46,7 @@ tests = testGroup "Persistence" -- write its only block, the genesis block. -- onlyGenesis :: Assertion -onlyGenesis = withDB chainId0 $ \g db -> do +onlyGenesis = withToyDB toyChainId $ \g db -> do persist p db g' <- runResourceT . S.head_ $ fileEntries @(ResourceT IO) p g' @?= Just g @@ -66,7 +62,7 @@ onlyGenesis = withDB chainId0 $ \g db -> do -- * The first block streamed from both the DB and the file will be the genesis. -- manyBlocksWritten :: Assertion -manyBlocksWritten = withDB chainId0 $ \g db -> do +manyBlocksWritten = withToyDB toyChainId $ \g db -> do void $ insertN len g db persist p db fromDB <- S.toList_ $ entries db Nothing Nothing Nothing Nothing diff --git a/test/Chainweb/Test/TreeDB/Sync.hs b/test/Chainweb/Test/TreeDB/Sync.hs index d9a920a750..6023a14d0e 100644 --- a/test/Chainweb/Test/TreeDB/Sync.hs +++ b/test/Chainweb/Test/TreeDB/Sync.hs @@ -12,10 +12,10 @@ import Test.Tasty.HUnit import Chainweb.BlockHeader (BlockHeader(..), BlockHeight(..)) import Chainweb.BlockHeaderDB (BlockHeaderDb, copy) -import Chainweb.ChainId (ChainId, unsafeChainId) +import Chainweb.ChainId (ChainId, _chainId) import Chainweb.Mempool.Mempool (MockTx) import Chainweb.RestAPI -import Chainweb.Test.Utils (insertN, withChainServer, withDB) +import Chainweb.Test.Utils (insertN, withChainServer, withToyDB, toyChainId) import Chainweb.TreeDB import Chainweb.TreeDB.RemoteDB import Chainweb.TreeDB.Sync @@ -42,8 +42,8 @@ tests = testGroup "Single-Chain Sync" diam :: Depth diam = Depth 6 -cid :: ChainId -cid = unsafeChainId 0 +withDB :: (BlockHeader -> BlockHeaderDb -> IO ()) -> IO () +withDB = withToyDB toyChainId blockHeaderDbs :: [(ChainId, BlockHeaderDb)] -> ChainwebServerDbs MockTx () HashMapCas blockHeaderDbs chainDbs = emptyChainwebServerDbs @@ -53,8 +53,8 @@ blockHeaderDbs chainDbs = emptyChainwebServerDbs -- | Syncing a length-1 chain to another length-1 chain should have no effect. -- noopSingletonSync :: Assertion -noopSingletonSync = withDB cid $ \g db -> do - withChainServer (blockHeaderDbs [(cid, db)]) $ \env -> do +noopSingletonSync = withDB $ \g db -> do + withChainServer (blockHeaderDbs [(_chainId db, db)]) $ \env -> do linearSync diam db . PeerTree $ RemoteDb env aNoLog (_blockChainwebVersion g) (_blockChainId g) maxRank db >>= (@?= 0) @@ -62,22 +62,22 @@ noopSingletonSync = withDB cid $ \g db -> do -- and finding none. -- noopLongSync :: Assertion -noopLongSync = withDB cid $ \g db -> do +noopLongSync = withDB $ \g db -> do void $ insertN 10 g db peer <- copy db - withChainServer (blockHeaderDbs [(cid, peer)]) $ \env -> do + withChainServer (blockHeaderDbs [(_chainId db, peer)]) $ \env -> do linearSync diam db . PeerTree $ RemoteDb env aNoLog (_blockChainwebVersion g) (_blockChainId g) maxRank db >>= (@?= 10) -- | Simulates a node that queries an /older/ node for updates. -- noopNewerNode :: Assertion -noopNewerNode = withDB cid $ \g peer -> do +noopNewerNode = withDB $ \g peer -> do void $ insertN 10 g peer db <- copy peer h <- maxHeader db void $ insertN 90 h db - withChainServer (blockHeaderDbs [(cid, peer)]) $ \env -> do + withChainServer (blockHeaderDbs [(_chainId db, peer)]) $ \env -> do let remote = PeerTree $ RemoteDb env aNoLog (_blockChainwebVersion g) (_blockChainId g) linearSync diam db remote maxRank db >>= (@?= 100) @@ -86,24 +86,24 @@ noopNewerNode = withDB cid $ \g peer -> do -- | Simulates a brand new node syncing everything from a peer. -- newNode :: Assertion -newNode = withDB cid $ \g db -> do +newNode = withDB $ \g db -> do peer <- copy db void $ insertN 10 g peer maxRank db >>= (@?= 0) - withChainServer (blockHeaderDbs [(cid, peer)]) $ \env -> do + withChainServer (blockHeaderDbs [(_chainId db, peer)]) $ \env -> do linearSync diam db . PeerTree $ RemoteDb env aNoLog (_blockChainwebVersion g) (_blockChainId g) maxRank db >>= (@?= 10) -- | Simulates an older node that hasn't been sync'd in a while. -- oldNode :: Assertion -oldNode = withDB cid $ \g db -> do +oldNode = withDB $ \g db -> do void $ insertN 10 g db peer <- copy db h <- maxHeader peer void $ insertN 90 h peer maxRank db >>= (@?= 10) maxRank peer >>= (@?= 100) - withChainServer (blockHeaderDbs [(cid, peer)]) $ \env -> do + withChainServer (blockHeaderDbs [(_chainId db, peer)]) $ \env -> do linearSync diam db . PeerTree $ RemoteDb env aNoLog (_blockChainwebVersion g) (_blockChainId g) maxRank db >>= (@?= 100) diff --git a/test/Chainweb/Test/Utils.hs b/test/Chainweb/Test/Utils.hs index 9ee927ce95..e3533a639e 100644 --- a/test/Chainweb/Test/Utils.hs +++ b/test/Chainweb/Test/Utils.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} @@ -21,8 +22,10 @@ module Chainweb.Test.Utils ( -- * BlockHeaderDb Generation toyBlockHeaderDb +, toyChainId , toyGenesis -, withDB +, genesisBlockHeaderForChain +, withToyDB , insertN , prettyTree , normalizeTree @@ -79,6 +82,7 @@ import Control.Concurrent import Control.Concurrent.Async import Control.Exception (SomeException, bracket, handle) import Control.Lens (deep, filtered, toListOf) +import Control.Monad.Catch (MonadThrow) import Control.Monad.IO.Class import Data.Aeson (FromJSON, ToJSON) @@ -131,7 +135,7 @@ import Chainweb.Test.P2P.Peer.BootstrapConfig import Chainweb.Time import Chainweb.TreeDB import Chainweb.Utils -import Chainweb.Version (ChainwebVersion(..)) +import Chainweb.Version import Data.CAS.HashMap hiding (toList) @@ -142,11 +146,17 @@ import Numeric.AffineSpace import qualified P2P.Node.PeerDB as P2P -- -------------------------------------------------------------------------- -- --- BlockHeaderDb Generation +-- Toy Values +-- +-- All toy values are based on `toyVersion`. Don't use these values with another +-- chainweb version! toyVersion :: ChainwebVersion toyVersion = Test singletonChainGraph +toyChainId :: ChainId +toyChainId = someChainId toyVersion + toyGenesis :: ChainId -> BlockHeader toyGenesis cid = genesisBlockHeader toyVersion cid @@ -163,8 +173,21 @@ toyBlockHeaderDb cid = (g,) <$> initBlockHeaderDb (Configuration g) -- an initialized `BlockHeaderDb`, perform some action -- and cleanly close the DB. -- -withDB :: ChainId -> (BlockHeader -> BlockHeaderDb -> IO ()) -> IO () -withDB cid = bracket (toyBlockHeaderDb cid) (closeBlockHeaderDb . snd) . uncurry +withToyDB :: ChainId -> (BlockHeader -> BlockHeaderDb -> IO ()) -> IO () +withToyDB cid = bracket (toyBlockHeaderDb cid) (closeBlockHeaderDb . snd) . uncurry + +-- -------------------------------------------------------------------------- -- +-- BlockHeaderDb Generation + +genesisBlockHeaderForChain + :: MonadThrow m + => HasChainwebVersion v + => Integral i + => v + -> i + -> m BlockHeader +genesisBlockHeaderForChain v i + = genesisBlockHeader (_chainwebVersion v) <$> mkChainId v i -- | Populate a `TreeDb` with /n/ generated `BlockHeader`s. -- @@ -217,7 +240,7 @@ tree v g = do -- | Generate a sane, legal genesis block for 'Test' chainweb instance -- genesis :: ChainwebVersion -> Gen BlockHeader -genesis v = return $ genesisBlockHeader v (unsafeChainId 0) +genesis v = either (error . sshow) return $ genesisBlockHeaderForChain v (0 :: Int) forest :: Growth -> BlockHeader -> Gen (Forest BlockHeader) forest Randomly h = randomTrunk h @@ -252,11 +275,11 @@ header h = do return . fromLog . newMerkleLog - $ _blockHash h + $ nonce + :+: BlockCreationTime (scaleTimeSpan (10 :: Int) second `add` t) + :+: _blockHash h :+: target :+: testBlockPayload h - :+: BlockCreationTime (scaleTimeSpan (10 :: Int) second `add` t) - :+: nonce :+: _chainId h :+: BlockWeight (targetToDifficulty v target) + _blockWeight h :+: succ (_blockHeight h) @@ -278,7 +301,7 @@ singleton :: ChainGraph singleton = singletonChainGraph testBlockHeaderDbs :: ChainwebVersion -> IO [(ChainId, BlockHeaderDb)] -testBlockHeaderDbs v = mapM toEntry $ toList $ chainIds_ (_chainGraph v) +testBlockHeaderDbs v = mapM toEntry $ toList $ chainIds v where toEntry c = do d <- db c diff --git a/test/ChainwebTests.hs b/test/ChainwebTests.hs index 88634b52f9..38f29daf45 100644 --- a/test/ChainwebTests.hs +++ b/test/ChainwebTests.hs @@ -19,7 +19,7 @@ import Test.Tasty.QuickCheck -- internal modules -import qualified Chainweb.Cut (properties) +import qualified Chainweb.Cut.Test (properties) import qualified Chainweb.Difficulty (properties) import qualified Chainweb.HostAddress (properties) import qualified Chainweb.Sync.WebBlockHeaderStore.Test (properties) @@ -105,6 +105,6 @@ suite = , testProperties "Data.PQueue.Test" Data.PQueue.Test.properties , testProperties "Chainweb.Difficulty" Chainweb.Difficulty.properties , testProperties "Data.Word.Encoding" Data.Word.Encoding.properties - , testProperties "Chainweb.Cut" Chainweb.Cut.properties + , testProperties "Chainweb.Cut.Test" Chainweb.Cut.Test.properties ] ] diff --git a/test/config/new-block-expected-0-blockOuts-hash.txt b/test/config/new-block-expected-0-blockOuts-hash.txt index 842a465ab5..a22ab2612b 100644 --- a/test/config/new-block-expected-0-blockOuts-hash.txt +++ b/test/config/new-block-expected-0-blockOuts-hash.txt @@ -1 +1 @@ -"wTnmrtf-BlMFZtbLnSG5AUAJ5b7gU-NgQNw7tHHCoTA" \ No newline at end of file +"gspth0GZybMBPFoIzMMMXKtSvsxA0q-s3iQu8bzuCPk" \ No newline at end of file diff --git a/test/config/new-block-expected-0-blockPayHash.txt b/test/config/new-block-expected-0-blockPayHash.txt index f59483b798..d8afede4b9 100644 --- a/test/config/new-block-expected-0-blockPayHash.txt +++ b/test/config/new-block-expected-0-blockPayHash.txt @@ -1 +1 @@ -"BfVTcqwi9Nd0EDTM_pmSqD3NQmufXQjF-9RTN_G4ajk" \ No newline at end of file +"dq5rtV4Mrzfxnnqoj5rZ7VAvEdU2yRCqWNknTAlNdaM" \ No newline at end of file diff --git a/test/config/new-empty-expected-0-blockOuts-hash.txt b/test/config/new-empty-expected-0-blockOuts-hash.txt index e2b626bfc7..75992fbe48 100644 --- a/test/config/new-empty-expected-0-blockOuts-hash.txt +++ b/test/config/new-empty-expected-0-blockOuts-hash.txt @@ -1 +1 @@ -"bcoV5kJuLod_7to28MttwNuntDjHoqHSSlIdJmVYlm8" \ No newline at end of file +"pPveennOK5z6hvoZQCkYxGYnzX2_lHfIbkdgQEKL4qw" \ No newline at end of file diff --git a/test/config/new-empty-expected-0-blockPayHash.txt b/test/config/new-empty-expected-0-blockPayHash.txt index ed36e3bd5a..0feb9a795f 100644 --- a/test/config/new-empty-expected-0-blockPayHash.txt +++ b/test/config/new-empty-expected-0-blockPayHash.txt @@ -1 +1 @@ -"uxFPlaIxH9KUedUW5mGwQjOisVvD67rVDShQ44PmNqk" \ No newline at end of file +"tFs7pKxBCkCDVoJr5xYGLShjHQ1oLm1hM5C3SGgAJes" \ No newline at end of file diff --git a/test/config/validateBlock-expected-0-blockOuts-hash.txt b/test/config/validateBlock-expected-0-blockOuts-hash.txt index 842a465ab5..a22ab2612b 100644 --- a/test/config/validateBlock-expected-0-blockOuts-hash.txt +++ b/test/config/validateBlock-expected-0-blockOuts-hash.txt @@ -1 +1 @@ -"wTnmrtf-BlMFZtbLnSG5AUAJ5b7gU-NgQNw7tHHCoTA" \ No newline at end of file +"gspth0GZybMBPFoIzMMMXKtSvsxA0q-s3iQu8bzuCPk" \ No newline at end of file diff --git a/test/config/validateBlock-expected-0-blockPayHash.txt b/test/config/validateBlock-expected-0-blockPayHash.txt index f59483b798..d8afede4b9 100644 --- a/test/config/validateBlock-expected-0-blockPayHash.txt +++ b/test/config/validateBlock-expected-0-blockPayHash.txt @@ -1 +1 @@ -"BfVTcqwi9Nd0EDTM_pmSqD3NQmufXQjF-9RTN_G4ajk" \ No newline at end of file +"dq5rtV4Mrzfxnnqoj5rZ7VAvEdU2yRCqWNknTAlNdaM" \ No newline at end of file diff --git a/tools/ea/Ea.hs b/tools/ea/Ea.hs index 0b0f094e1c..09cf16edd8 100644 --- a/tools/ea/Ea.hs +++ b/tools/ea/Ea.hs @@ -50,7 +50,6 @@ import System.LogLevel (LogLevel(..)) import Chainweb.BlockHeader import Chainweb.BlockHeader.Genesis (genesisTime) -import Chainweb.ChainId (unsafeChainId) import Chainweb.Logger (genericLogger) import Chainweb.Miner.Genesis (mineGenesis) import Chainweb.Pact.PactService @@ -59,7 +58,7 @@ import Chainweb.Time (Time(..), TimeSpan(..)) import Chainweb.Transaction (PayloadWithText(..)) import Chainweb.Utils (sshow) import Chainweb.Version - (ChainwebVersion(..), chainwebVersionFromText, chainwebVersionToText) + (ChainwebVersion(..), chainwebVersionFromText, chainwebVersionToText, chainIds, someChainId) import Pact.ApiReq (mkApiReq) import Pact.Types.Command hiding (Payload) @@ -71,8 +70,6 @@ data Env w = Headers { version :: w ::: Text "The ChainwebVersion to use." - , chains :: w ::: Word16 - "The number of genesis blocks to to produce a genesis for." , time :: w ::: Maybe Int64 "Genesis Block Time, in microseconds since the Epoch. Default is the Genesis Time of the given ChainwebVersion." } | Payload @@ -86,10 +83,10 @@ instance ParseRecord (Env Wrapped) main :: IO () main = unwrapRecord "ea" >>= \case - Headers v0 cs t -> do + Headers v0 t -> do v <- chainwebVersionFromText v0 let crtm = maybe (genesisTime v) (BlockCreationTime . Time . TimeSpan) t - modl = headerModule v $ headers v cs crtm + modl = headerModule v $ headers v crtm file = "src/Chainweb/BlockHeader/Genesis/" <> moduleName v <> ".hs" TIO.writeFile (T.unpack file) modl putStrLn $ "Generated Genesis BlockHeaders for " <> show v @@ -113,11 +110,10 @@ moduleName = T.toTitle . chainwebVersionToText -- Header Generation -------------------- --- | Given a number of Genesis `BlockHeader`s to generate, do just that. -headers :: ChainwebVersion -> Word16 -> BlockCreationTime -> [BlockHeader] -headers v cs ct = take (fromIntegral cs) $ map f [0..] +headers :: ChainwebVersion -> BlockCreationTime -> [BlockHeader] +headers v ct = map f $ toList $ chainIds v where - f cid = mineGenesis v (unsafeChainId cid) ct (Nonce 0) + f cid = mineGenesis v cid ct (Nonce 0) headerModule :: ChainwebVersion -> [BlockHeader] -> Text headerModule v hs = T.unlines $ @@ -170,7 +166,7 @@ genPayloadModule v txFiles = do let logger = genericLogger Warn TIO.putStrLn - payloadWO <- initPactService' Testnet00 (unsafeChainId 0) logger noSPVSupport $ + payloadWO <- initPactService' Testnet00 (someChainId Testnet00) logger noSPVSupport $ execNewGenesisBlock noMiner (V.fromList cwTxs) let payloadYaml = TE.decodeUtf8 $ Yaml.encode payloadWO diff --git a/tools/run-nodes/RunNodes.hs b/tools/run-nodes/RunNodes.hs new file mode 100644 index 0000000000..a30d4dc3b6 --- /dev/null +++ b/tools/run-nodes/RunNodes.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} + +module Main ( main ) where + +import BasePrelude hiding (option, (%)) +import Chainweb.Graph (petersonChainGraph) +import Chainweb.Version +import Control.Concurrent (threadDelay) +import Control.Concurrent.Async +import Control.Error.Util (note) +import qualified Data.Text as T +import Formatting +import Options.Applicative +import Shelly hiding (FilePath) +import System.Directory (executable, getPermissions) + +--- + +data Env = Env + { exe :: FilePath + , nodes :: Word8 + , version :: ChainwebVersion + , config :: FilePath + , passthrough :: [T.Text] + } deriving (Show) + +pEnv :: Parser Env +pEnv = Env <$> pExe <*> pNodes <*> pVersion <*> pConfig <*> many pPassthrough + +pExe :: Parser FilePath +pExe = strOption + (long "exe" <> metavar "PATH" + <> help "Full path to a chainweb-node binary") + +pNodes :: Parser Word8 +pNodes = option auto + (long "nodes" <> metavar "COUNT" <> value 10 + <> help "Number of Nodes to run (default: 10)") + +pVersion :: Parser ChainwebVersion +pVersion = option cver + (long "version" <> metavar "VERSION" + <> value (TestWithTime petersonChainGraph) + <> help "Chainweb Version to run the Nodes with (default: testWithTime-peterson)") + where + cver :: ReadM ChainwebVersion + cver = eitherReader $ \s -> + note "Illegal ChainwebVersion" . chainwebVersionFromText $ T.pack s + +pConfig :: Parser FilePath +pConfig = strOption + (long "config" <> metavar "PATH" <> value "tools/run-nodes/test-bootstrap-node.config" + <> help "Path to Chainweb config YAML file") + +pPassthrough :: Parser T.Text +pPassthrough = argument str + (metavar "CHAINWEB-FLAGS" <> help "Native flags that a chainweb-node accepts") + +runNode :: Word8 -> Maybe FilePath -> Env -> IO () +runNode nid mconf (Env e ns v _ ps) = shelly $ run_ (fromText $ T.pack e) ops + where + ops :: [T.Text] + ops = [ "--hostname=127.0.0.1" + , sformat ("--node-id=" % int) nid + , sformat ("--test-miners=" % int) ns + , sformat ("--chainweb-version=" % stext) $ chainwebVersionToText v + , "--interface=127.0.0.1" ] + <> maybe [] (\c -> [sformat ("--config-file=" % string) c]) mconf + <> ps + <> [ "+RTS", "-T" ] + +main :: IO () +main = do + env@(Env e ns _ c _) <- execParser opts + print env + canExec <- (executable <$> getPermissions e) `catch` (\(_ :: SomeException) -> pure False) + if | not canExec -> error $ e <> " is not executable, or does not exist." + | otherwise -> do + putStrLn "Starting cluster..." + -- Launch Bootstrap Node + withAsync (runNode 0 (Just c) env) $ \boot -> do + link boot + threadDelay 1000000 -- 1 second + -- Launch Common Nodes + mapConcurrently_ (\n -> runNode n Nothing env) [1 .. ns - 1] + where + opts = info (pEnv <**> helper) + (fullDesc <> header "run-nodes - Run a local cluster of chainweb-node binaries") diff --git a/scripts/test-bootstrap-node.config b/tools/run-nodes/test-bootstrap-node.config similarity index 100% rename from scripts/test-bootstrap-node.config rename to tools/run-nodes/test-bootstrap-node.config