Merge branch 'master' into feature/pact-poll

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:

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

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

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";

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]

examples/P2pExample.hs

@@ -83,7 +83,7 @@ defaultP2pExampleConfig = P2pExampleConfig
     , _maxPeerCount = 50
     , _sessionTimeoutSeconds = 20
     , _meanSessionSeconds = 10
-    , _exampleChainId = unsafeChainId 0
+    , _exampleChainId = someChainId version
     , _logConfig = defaultLogConfig
     }
 

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

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)