├── .github └── workflows │ └── build-application.yml ├── .gitignore ├── CHANGELOG.md ├── LICENSE ├── README.org ├── cabal.project ├── chainweb-miner.cabal ├── default.nix ├── dep └── kpkgs │ ├── default.nix │ └── github.json ├── exec ├── Miner.hs └── Miner │ ├── Balance.hs │ ├── Types.hs │ └── Updates.hs └── stack.yaml /.github/workflows/build-application.yml: -------------------------------------------------------------------------------- 1 | name: Build and publish application binaries 2 | 3 | on: [push] 4 | 5 | env: 6 | AWS_ACCESS_KEY_ID: ${{ secrets.kadena_cabal_cache_aws_access_key_id }} 7 | AWS_SECRET_ACCESS_KEY: ${{ secrets.kadena_cabal_cache_aws_secret_access_key }} 8 | 9 | jobs: 10 | build: 11 | name: Build 12 | runs-on: ${{ matrix.os }} 13 | strategy: 14 | fail-fast: false 15 | matrix: 16 | ghc: ['8.8.3', '8.10.1'] 17 | cabal: ['3.2.0.0'] 18 | os: ['ubuntu-18.04', 'macOS-10.14'] 19 | cabalcache: ['true'] 20 | env: 21 | ARTIFACT_BUCKET: kadena-cabal-cache 22 | ARTIFACT_FOLDER: chainweb-miner 23 | 24 | steps: 25 | 26 | # Setup 27 | - name: Checkout repository 28 | uses: actions/checkout@v2.2.0 29 | - name: Create env variables for git objects 30 | run: | 31 | echo "::set-env name=IS_RELEASE::${{ contains(github.event_name, 'release') }}" 32 | echo "::set-env name=GIT_REF_SHORT::${GITHUB_REF#refs/heads/}" 33 | echo "::set-env name=GIT_HEAD_REF_SHORT::${GITHUB_HEAD_REF#refs/heads/}" 34 | echo "::set-env name=GIT_SHA_SHORT::$(git rev-parse --short HEAD || true)" 35 | - name: Install GHC and Cabal 36 | uses: actions/setup-haskell@v1.1.2 37 | with: 38 | ghc-version: ${{ matrix.ghc }} 39 | cabal-version: ${{ matrix.cabal }} 40 | - name: Confirm GHC and Cabal installation 41 | run: | 42 | ghc --version 43 | cabal --version 44 | - name: Install non-Haskell dependencies (ubuntu) 45 | if: contains(matrix.os, 'ubuntu') 46 | run: | 47 | sudo apt-get update 48 | sudo apt-get install -y librocksdb-dev zlib1g-dev libtinfo-dev libsqlite3-dev libz3-dev z3 49 | - name: Install non-Haskell dependencies (macOS) 50 | if: contains(matrix.os, 'mac') 51 | run: | 52 | brew update 53 | brew install z3 54 | brew install sqlite 55 | brew install rocksdb 56 | - name: Append cabal.project 57 | run: | 58 | cat >> cabal.project <> cabal.project.local <:443 --miner-account= --miner-key= 69 | #+end_src 70 | 71 | The list of trusted nodes can be found [[https://github.com/kadena-io/chainweb-node/wiki][here]]. 72 | 73 | Things to note: 74 | 75 | - You can dedicate as many cores to parallel mining as you want with ~--cores~. 76 | - If specifying the number of cores, the ~--cores~ flag must follow directly after the ~cpu~ flag. 77 | - When ~--cores~ is omitted during CPU mining, then the number of cores used will default to 1. 78 | - You can only communicate with one Node at a time. 79 | - As stated above, your declared account must be owned by you, or your rewards 80 | will likely be lost. 81 | 82 | *** GPU Mining 83 | 84 | We also provide a GPU Miner which integrates with ~chainweb-miner~. Installation 85 | and usage instructions [[https://github.com/kadena-io/chainweb-cuda-miner][can found here]]. 86 | 87 | *** Chain Focusing 88 | 89 | You might have a reason to prioritize one chain over the rest. To request that 90 | the Node attempt to give you work for a specific chain first, pass ~--chain~: 91 | 92 | #+begin_src bash 93 | ./chainweb-miner cpu --chain=9 ... # other flags 94 | #+end_src 95 | 96 | *** Log Suppression 97 | 98 | You may only be interested in warning or error messages. If so, use the 99 | ~--log-level~ flag: 100 | 101 | #+begin_src bash 102 | chainweb-miner cpu --log-level=warn ... # other flags 103 | #+end_src 104 | 105 | #+begin_example 106 | 2019-09-16 16:57:56.755636: [warn] Couldn't connect to update stream. Trying again... 107 | 2019-09-16 16:58:23.646547: [error] Failed to fetch work! Is the Node down? 108 | #+end_example 109 | 110 | *** Specifying Multiple Nodes 111 | 112 | You can specify multiple nodes to mine from the command line. 113 | *However*, what this actually means needs to be clarified. Consider 114 | this example: 115 | 116 | #+BEGIN_SRC bash 117 | ./chainweb-miner cpu --node=us-e3.chainweb.com:443 118 | --node=us-e2.chainweb.com:443 ... 119 | #+END_SRC 120 | 121 | Before discussing the aforementioned necessary clarification, note 122 | that specifying multiple nodes is rather straightforward: just add 123 | another ~--node=~ clause (as found in the example)! Now, when you 124 | specify multiple nodes to mine, this does not mean that the first 125 | block you mine is from us-e3.chainweb.com while the second is from 126 | us-e2.chainweb.com. Instead, the first node found on the command line 127 | is the first node the chainweb-miner attempts to communicate with to 128 | find blocks to mine. If for some reason, the chainweb-miner is unable 129 | to establish a connection with the node, then it will attempt to 130 | establish a connection with the specified next node. This process will 131 | continue until there are no more nodes left to consider. Upon this 132 | event, the chainweb-miner process will halt and exit. For example, 133 | given the above example, if the chainweb-miner cannot communicate with 134 | either us-e3.chainweb or us-e2.chainweb.com, then the process 135 | terminates. 136 | 137 | Also, the first node specified from the left is the first node that 138 | chainweb-miner attempts to form a communication channel to get blocks 139 | to mine. 140 | 141 | *** Balance Lookup 142 | 143 | Given a node url, you can check the balance of a given miner acccount 144 | with the chainweb-miner tool. Let's look at this example: 145 | 146 | #+BEGIN_SRC bash 147 | ./chainweb-miner balance-check --node=us-w2.chainweb.com:443 --miner-account exampleaccount 148 | #+END_SRC 149 | 150 | Drawing upon this example, you are allowed to only query one node and 151 | you must specify the miner account. This feature will automatically 152 | query your balance on all nodes and also print the total amount across 153 | all chains. Here is some example output: 154 | 155 | #+BEGIN_EXAMPLE 156 | The balance on chain 0 is 39.176891. 157 | The balance on chain 1 is 69.13569. 158 | The balance on chain 2 is 69.13569. 159 | The balance on chain 3 is 53.004029. 160 | The balance on chain 4 is 57.613075. 161 | The balance on chain 5 is 76.049259. 162 | The balance on chain 6 is 53.004029. 163 | The balance on chain 7 is 50.699506. 164 | The balance on chain 8 is 64.526644. 165 | The balance on chain 9 is 48.394983. 166 | Your total is 580.739796000000 167 | #+END_EXAMPLE 168 | 169 | 170 | We recommend querying your balance from the node you have been mining 171 | to as well as a couple other nodes (i.e. the bootstrap nodes). 172 | ** Troubleshooting 173 | 174 | *** I mined using the wrong account name and/or public key! 175 | 176 | Your coins are likely gone. 177 | 178 | | | Your Key | Not Your Key | 179 | |----------------------+------------------------+-------------------------| 180 | | Your Account | Hurray! | Work rejected by Node. | 181 | |----------------------+------------------------+-------------------------| 182 | | Not Your Account | Work rejected by Node. | Work rejected by Node. | 183 | |----------------------+------------------------+-------------------------| 184 | | Non-existant Account | You own a new account! | *Coins locked forever.* | 185 | 186 | *** chainweb-miner says that I mined, but I didn't receive the reward. 187 | 188 | This? 189 | 190 | #+begin_example 191 | 2019-09-16 16:58:37.289252: [info] Chain 6: Mined block at Height 12440. 192 | #+end_example 193 | 194 | And yet your balance on Chain 6 remains unchanged? 195 | 196 | Mining is a big race. Even if you succeeded on Chain 6, by the time your block 197 | returned to the Node, the Node may have already registered a faster block. 198 | 199 | #+begin_quote 200 | But if it knew about a better block on my chain, why didn't it preempt me? 201 | #+end_quote 202 | 203 | Race conditions. There's a small time window between the Node processing the 204 | faster block, telling you about it, and you submitting your own block. Consider 205 | it bad luck. 206 | 207 | *** I specify ~--chain=...~ but am getting work for other chains. Why? 208 | 209 | It is fundamental to the design of a Chainweb network that chains cannot 210 | progress much further than their neighbor chains. It may be that by asking for 211 | ~--chain=9~, the Node couldn't find work to do! In this case, it falls back to 212 | picking a random chain. This balances the needs of the Miner, who may want a 213 | specific Chain to progress efficiently, with the needs of the network, which 214 | requires all chains to grow evenly. 215 | 216 | *** Why am I being "preempted" so much? 217 | 218 | This? 219 | 220 | #+begin_example 221 | 2019-09-16 17:30:11.791641: [debug] Chain 7: Current work was preempted. 222 | 2019-09-16 17:30:15.759249: [debug] Chain 8: Current work was preempted. 223 | 2019-09-16 17:30:27.340109: [debug] Chain 9: Current work was preempted. 224 | 2019-09-16 17:30:57.343577: [debug] Chain 6: Current work was preempted. 225 | 2019-09-16 17:31:04.998382: [debug] Chain 9: Current work was preempted. 226 | 2019-09-16 17:31:14.649440: [debug] Chain 1: Current work was preempted. 227 | 2019-09-16 17:31:25.503355: [debug] Chain 4: Current work was preempted. 228 | 2019-09-16 17:31:45.471371: [debug] Chain 9: Current work was preempted. 229 | 2019-09-16 17:31:56.940698: [debug] Chain 2: Current work was preempted. 230 | 2019-09-16 17:32:16.807348: [debug] Chain 9: Current work was preempted. 231 | 2019-09-16 17:32:21.721842: [debug] Chain 8: Current work was preempted. 232 | #+end_example 233 | 234 | This is normal. This means that other miners are beating you, and that you 235 | probably don't hold much of the overall network hash power. 236 | 237 | * Remote API Details 238 | 239 | A ~chainweb-miner~ communicates with a ~chainweb-node~ via the following 240 | endpoints. 241 | 242 | ** Work Requests 243 | 244 | #+begin_quote 245 | Intent: I want a new BlockHeader to mine on. 246 | #+end_quote 247 | 248 | #+begin_example 249 | GET /chainweb/0.0/mainnet01/mining/work?chain=... 250 | #+end_example 251 | 252 | Clients can optionally specify a Chain to "focus" on. 253 | 254 | Request Body (JSON): 255 | 256 | #+begin_src js 257 | { 258 | "account": "miner", 259 | "predicate": "keys-all", 260 | "public-keys": [ 261 | "f880a433d6e2a13a32b6169030f56245efdd8c1b8a5027e9ce98a88e886bef27" 262 | ] 263 | } 264 | #+end_src 265 | 266 | Response (Octet Stream): 267 | 268 | #+begin_example 269 | Work Bytes - 322 bytes 270 | 271 | ChainBytes(4) + TargetBytes(32) + HeaderBytes(286) 272 | 273 | The minimum information required to perform Proof-of-Work. No knowledge of 274 | Chainweb internals is necessary. 275 | #+end_example 276 | 277 | | Piece | Description | 278 | |-------------+---------------------------------------------| 279 | | ChainBytes | The final chain selection made by the Node. | 280 | | TargetBytes | Encoded form of the current Hash Target. | 281 | | HeaderBytes | Encoded form of the Block Header. | 282 | 283 | ** Solution Submission 284 | 285 | #+begin_quote 286 | Intent: I solved a block - here it is. 287 | #+end_quote 288 | 289 | #+begin_example 290 | POST /chainweb/0.0/mainnet01/mining/solved 291 | #+end_example 292 | 293 | Request Body (Octet Stream): 294 | 295 | #+begin_example 296 | Header Bytes - 286 bytes 297 | 298 | The original work received, updated internally with the Nonce that satisfies the 299 | Proof-of-Work. 300 | #+end_example 301 | 302 | ** Update Subscription 303 | 304 | #+begin_quote 305 | Intent: I am currently mining. Is the work I'm doing still worth it? 306 | #+end_quote 307 | 308 | #+begin_example 309 | GET /chainweb/0.0/mainnet01/mining/updates 310 | #+end_example 311 | 312 | Request Body (Octet Stream): 313 | 314 | #+begin_example 315 | Chain Bytes - 4 bytes 316 | 317 | The first 4 bytes received from a call to /mining/work. This tells the Node to 318 | only inform the Miner of a new Cut when the specific chain in question has 319 | updated. 320 | #+end_example 321 | 322 | Response (Server-Sent Event): 323 | 324 | #+begin_example 325 | A stream of Server-Sent Events with a single line: 326 | 327 | event:New Cut 328 | #+end_example 329 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: . 2 | 3 | package aeson 4 | flags: +cffi 5 | 6 | debug-info: True 7 | 8 | source-repository-package 9 | type: git 10 | location: https://github.com/kadena-io/chainweb-node.git 11 | tag: be3d78afb18934e5268d2f95ab9a69226750f0f3 12 | 13 | source-repository-package 14 | type: git 15 | location: https://github.com/kadena-io/pact.git 16 | tag: 2ca4cae3eb8a0ef2783aa9457388c31b44a0dfbc 17 | 18 | source-repository-package 19 | type: git 20 | location: https://github.com/kadena-io/thyme.git 21 | tag: 6ee9fcb026ebdb49b810802a981d166680d867c9 22 | 23 | source-repository-package 24 | type: git 25 | location: https://github.com/kadena-io/chainweb-storage.git 26 | tag: 07e7eb7596c7105aee42dbdb6edd10e3f23c0d7e 27 | 28 | source-repository-package 29 | type: git 30 | location: https://github.com/kadena-io/rosetta.git 31 | tag: 1ccb68d7aec0414f494fb06f591214e7cf845627 32 | 33 | package vault 34 | documentation: false 35 | -------------------------------------------------------------------------------- /chainweb-miner.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | 3 | name: chainweb-miner 4 | version: 1.1.0 5 | description: Official mining software for the Kadena Public Blockchain. 6 | homepage: https://github.com/kadena-io/chainweb-miner 7 | author: Kadena Developers 8 | maintainer: colin@kadena.io 9 | copyright: 2019 Kadena LLC 10 | license: BSD-3-Clause 11 | license-file: LICENSE 12 | build-type: Simple 13 | 14 | extra-source-files: 15 | README.org 16 | CHANGELOG.md 17 | 18 | common commons 19 | default-language: Haskell2010 20 | build-depends: base >= 4.12 && < 5 21 | ghc-options: 22 | -Wall 23 | -Wcompat 24 | -Wpartial-fields 25 | -Wincomplete-record-updates 26 | -Wincomplete-uni-patterns 27 | -Widentities 28 | -funclutter-valid-hole-fits 29 | -fmax-relevant-binds=0 30 | 31 | executable chainweb-miner 32 | import: commons 33 | hs-source-dirs: exec 34 | main-is: Miner.hs 35 | other-modules: 36 | Miner.Balance 37 | Miner.Types 38 | Miner.Updates 39 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 40 | build-depends: 41 | bytestring >= 0.10 42 | , bytes >= 0.17 43 | , Decimal >= 0.4.2 44 | , aeson >= 1.4.3 45 | , chainweb >= 1.19 46 | , connection >= 0.2 47 | , dlist >= 0.8 48 | , semigroupoids >= 5 49 | , generic-lens >= 1.2 50 | , http-client >= 0.6 51 | , http-client-tls >= 0.3 52 | , http-types >= 0.12 53 | , mwc-random >= 0.14 54 | , optparse-applicative >= 0.14 55 | , pact >= 3.3 56 | , paths >= 0.2 57 | , retry >= 0.8 58 | , rio >= 0.1.12 59 | , scheduler >= 1.4.2 60 | , servant-client >= 0.16 61 | , streaming >= 0.2 62 | , streaming-events >= 1.0 63 | , strict-tuple >= 0.1.3 64 | , these >= 1 && < 1.1 65 | , time >= 1.8 66 | , wai-extra >= 3.0 67 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | { kpkgs ? import ./dep/kpkgs {} 2 | }: 3 | let pkgs = kpkgs.pkgs; 4 | haskellPackages = kpkgs.rp.ghc8_6; 5 | 6 | in haskellPackages.developPackage { 7 | name = builtins.baseNameOf ./.; 8 | root = kpkgs.gitignoreSource ./.; 9 | modifier = drv: pkgs.haskell.lib.overrideCabal drv (attrs: { 10 | buildTools = (attrs.buildTools or []) ++ [ 11 | haskellPackages.cabal-install 12 | haskellPackages.ghcid 13 | ]; 14 | }); 15 | } 16 | -------------------------------------------------------------------------------- /dep/kpkgs/default.nix: -------------------------------------------------------------------------------- 1 | # DO NOT HAND-EDIT THIS FILE 2 | let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }: 3 | if !fetchSubmodules && !private then builtins.fetchTarball { 4 | url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256; 5 | } else (import {}).fetchFromGitHub { 6 | inherit owner repo rev sha256 fetchSubmodules private; 7 | }; 8 | in import (fetch (builtins.fromJSON (builtins.readFile ./github.json))) 9 | -------------------------------------------------------------------------------- /dep/kpkgs/github.json: -------------------------------------------------------------------------------- 1 | { 2 | "owner": "kadena-io", 3 | "repo": "kpkgs", 4 | "branch": "master", 5 | "private": false, 6 | "rev": "53b7e5c4d82e8640df28a79a9e0307fb61eb042e", 7 | "sha256": "1wzgrcmh85x402bahi2sqp049vrha161h1mkysl9gz8fgnv0zgvz" 8 | } 9 | -------------------------------------------------------------------------------- /exec/Miner.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE DataKinds #-} 3 | {-# LANGUAGE DerivingStrategies #-} 4 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 5 | {-# LANGUAGE LambdaCase #-} 6 | {-# LANGUAGE MultiWayIf #-} 7 | {-# LANGUAGE NoImplicitPrelude #-} 8 | {-# LANGUAGE NumericUnderscores #-} 9 | {-# LANGUAGE OverloadedStrings #-} 10 | {-# LANGUAGE RankNTypes #-} 11 | {-# LANGUAGE ScopedTypeVariables #-} 12 | {-# LANGUAGE TypeApplications #-} 13 | {-# LANGUAGE TypeOperators #-} 14 | 15 | -- | 16 | -- Module: Main 17 | -- Copyright: Copyright © 2019 Kadena LLC. 18 | -- License: MIT 19 | -- Maintainer: Colin Woodbury 20 | -- Stability: experimental 21 | -- 22 | -- The fast "inner loop" of the mining process. Asks for work from a Chainweb 23 | -- Node, and submits results back to it. 24 | -- 25 | -- == Purpose and Expectations == 26 | -- 27 | -- This tool is a low-level, pull-based, independent, focusable, multicore CPU 28 | -- and GPU miner for Chainweb. By this we mean: 29 | -- 30 | -- * low-level: The miner is not aware of how `BlockHeader`s are encoded into 31 | -- `ByteString`s, as indicated by an external spec. It does not know how to 32 | -- construct a full `BlockHeader` type, nor does it need to. It has no 33 | -- concept of `Cut`s or the cut network used by Chainweb - it simply 34 | -- attempts `Nonce`s until a suitable hash is found that matches the current 35 | -- `HashTarget`. 36 | -- 37 | -- * pull-based: Work is requested from some remote Chainweb Node, as 38 | -- configured on the command line. The Miner is given an encoded candidate 39 | -- `BlockHeader`, which it then injects a `Nonce` into, hashes, and checks 40 | -- for a solution. If/when a solution is found, it is sent back to the 41 | -- Chainweb Node to be reassociated with its Payload and published as a new 42 | -- `Cut` to the network. 43 | -- 44 | -- * independent: It is assumed that in general, individuals running Chainweb 45 | -- Miners and Chainweb Nodes are separate entities. A Miner requests work 46 | -- from a Node and trusts them to assemble a block. Nodes do not know who is 47 | -- requesting work, but Miners know who they're requesting work from. In 48 | -- this way, there is a many-to-one relationship between Mining Clients and 49 | -- a Node. 50 | -- 51 | -- * focusable: A Miner can be configured to prioritize work belonging to a 52 | -- specific chain. Note, however, that if a work request for a particular 53 | -- chain can't be filled by a Node (if say that Chain has progressed too far 54 | -- relative to its neighbours), then the Node will send back whatever it 55 | -- could find. This strategy is to balance the needs of Miners who have a 56 | -- special interest in progressing a specific chain with the needs of the 57 | -- network which requires even progress across all chains. 58 | -- 59 | -- * multicore: The miner uses 1 CPU core by default, but can use as many as 60 | -- you indicate. GPU support is also available. 61 | -- 62 | 63 | module Main ( main ) where 64 | 65 | import Control.Retry 66 | import Control.Scheduler hiding (traverse_) 67 | import Data.Bytes.Get 68 | import Data.Bytes.Put 69 | import qualified Data.ByteString.Short as BS 70 | import Data.Time.Clock.POSIX (getPOSIXTime) 71 | import Data.Tuple.Strict (T2(..), T3(..)) 72 | import Network.HTTP.Client hiding (Proxy(..), responseBody) 73 | import Network.HTTP.Client.TLS (mkManagerSettings) 74 | import Network.HTTP.Types.Status (Status(..)) 75 | import Options.Applicative 76 | import RIO 77 | import qualified RIO.ByteString as B 78 | import qualified RIO.ByteString.Lazy as BL 79 | import RIO.List.Partial (head) 80 | import qualified RIO.NonEmpty as NEL 81 | import qualified RIO.NonEmpty.Partial as NEL 82 | import qualified RIO.Text as T 83 | import Servant.Client 84 | import qualified System.Path as Path 85 | import qualified System.Random.MWC as MWC 86 | import Text.Printf (printf) 87 | 88 | -- internal modules 89 | 90 | import Chainweb.BlockHeader 91 | import Chainweb.BlockHeader.Validation (prop_block_pow) 92 | import Chainweb.BlockHeight 93 | import Chainweb.Cut.Create 94 | import Chainweb.Difficulty 95 | import Chainweb.Miner.Core 96 | import Chainweb.Miner.RestAPI.Client (solvedClient, workClient) 97 | import Chainweb.RestAPI.NodeInfo (NodeInfo(..), NodeInfoApi) 98 | import Chainweb.Utils (runGet) 99 | import Chainweb.Version 100 | import Miner.Balance 101 | import Miner.Types 102 | import Miner.Updates 103 | import qualified Pact.Types.Crypto as P hiding (PublicKey) 104 | import qualified Pact.Types.Util as P 105 | 106 | -------------------------------------------------------------------------------- 107 | -- Work 108 | 109 | main :: IO () 110 | main = execParser opts >>= \case 111 | cmd@(CPU _ cargs) -> work cmd cargs >> exitFailure 112 | cmd@(GPU _ cargs) -> work cmd cargs >> exitFailure 113 | Otherwise Keys -> genKeys 114 | Otherwise (Balance url account) -> getBalances url account 115 | where 116 | opts :: ParserInfo Command 117 | opts = info (pCommand <**> helper) 118 | (fullDesc <> progDesc "The Official Chainweb Mining Client") 119 | 120 | work :: Command -> ClientArgs -> IO () 121 | work cmd cargs = do 122 | lopts <- setLogMinLevel (ll cargs) . setLogUseLoc False <$> logOptionsHandle stderr True 123 | withLogFunc lopts $ \logFunc -> do 124 | g <- MWC.createSystemRandom 125 | m <- newManager (mkManagerSettings tlsSettings Nothing) 126 | euvs <- sequence <$> traverse (nodeVer m) (coordinators cargs) 127 | case euvs of 128 | Left e -> throwString $ show e 129 | Right results -> do 130 | mUrls <- newIORef $ NEL.fromList results 131 | stats <- newIORef 0 132 | start <- newIORef 0 133 | successStart <- getPOSIXTime >>= newIORef 134 | updateMap <- newUpdateMap 135 | runRIO (Env g m logFunc cmd cargs stats start successStart updateMap mUrls) run 136 | where 137 | nodeVer :: Manager -> BaseUrl -> IO (Either ClientError (T2 BaseUrl ChainwebVersion)) 138 | nodeVer m baseurl = (T2 baseurl <$>) <$> getInfo m baseurl 139 | 140 | 141 | 142 | getInfo :: Manager -> BaseUrl -> IO (Either ClientError ChainwebVersion) 143 | getInfo m url = fmap nodeVersion <$> runClientM (client (Proxy @NodeInfoApi)) cenv 144 | where 145 | cenv = mkClientEnv m url 146 | 147 | run :: RIO Env () 148 | run = do 149 | env <- ask 150 | logInfo "Starting Miner." 151 | mining (scheme env) 152 | 153 | scheme :: Env -> (TargetBytes -> HeaderBytes -> RIO Env HeaderBytes) 154 | scheme env = case envCmd env of 155 | CPU e _ -> cpu e 156 | GPU e _ -> gpu e 157 | _ -> error "Impossible: You shouldn't reach this case." 158 | 159 | genKeys :: IO () 160 | genKeys = do 161 | kp <- P.genKeyPair P.defaultScheme 162 | printf "public: %s\n" (T.unpack . P.toB16Text $ P.getPublic kp) 163 | printf "private: %s\n" (T.unpack . P.toB16Text $ P.getPrivate kp) 164 | 165 | newtype GetWorkFailure = GetWorkFailure SomeException 166 | deriving (Show, Display) 167 | 168 | instance Exception GetWorkFailure 169 | 170 | -- | Attempt to get new work while obeying a sane retry policy. 171 | -- 172 | getWork :: RIO Env (T2 WorkBytes UpdateKey) 173 | getWork = do 174 | logDebug "Attempting to fetch new work from the remote Node" 175 | e <- ask 176 | retrying policy (const warn) (const . liftIO $ f e) >>= \case 177 | Left err -> throwM $ GetWorkFailure $ toException err 178 | Right bs -> T2 bs <$> workKey bs 179 | where 180 | -- | If we wait longer than the average block time and still can't get 181 | -- anything, then there's no point in continuing to wait. 182 | -- 183 | policy :: RetryPolicy 184 | policy = exponentialBackoff 500000 <> limitRetries 7 185 | 186 | warn :: Either ClientError WorkBytes -> RIO Env Bool 187 | warn (Right _) = pure False 188 | warn (Left se) = bad se $> True 189 | 190 | bad :: ClientError -> RIO Env () 191 | bad (ConnectionError _) = logWarn "Could not connect to the Node." 192 | bad (FailureResponse _ r) = logWarn $ c <> " from Node: " <> m 193 | where 194 | c = display . statusCode $ responseStatusCode r 195 | m = displayBytesUtf8 . BL.toStrict $ responseBody r 196 | bad _ = logError "Something truly bad has happened." 197 | 198 | f :: Env -> IO (Either ClientError WorkBytes) 199 | f e = do 200 | T2 u v <- NEL.head <$> readIORef (envUrls e) 201 | runClientM (workClient v (chainid a) $ miner a) (mkClientEnv m u) 202 | where 203 | a = envArgs e 204 | m = envMgr e 205 | 206 | workKey :: WorkBytes -> RIO Env UpdateKey 207 | workKey wb = do 208 | T3 cbytes _ _ <- runGet unWorkBytes $ _workBytes wb 209 | cid <- liftIO $ chain cbytes 210 | return $! UpdateKey { _updateKeyChainId = cid } 211 | 212 | -- -------------------------------------------------------------------------- -- 213 | -- Mining 214 | 215 | -- | A supervisor thread that listens for new work and manages mining threads. 216 | -- 217 | -- TODO: use exponential backoff instead of fixed delay when retrying. 218 | -- (restart retry sequence when the maximum retry count it reached) 219 | -- 220 | mining :: (TargetBytes -> HeaderBytes -> RIO Env HeaderBytes) -> RIO Env () 221 | mining go = miningLoop go `finally` logInfo "Miner halted." 222 | 223 | data Recovery = Irrecoverable | Recoverable | NodeSwitch 224 | 225 | -- | The inner mining loop. 226 | -- 227 | -- It uses 'getWork' to obtain new work and starts mining. If a block is solved it 228 | -- calls 'miningSuccess' and loops around. 229 | -- 230 | -- It also starts over with new work when an update is triggered. 231 | -- 232 | -- NOTE: if this fails continuously, e.g. because of a miss-configured or buggy 233 | -- miner, this function will spin forever! 234 | -- 235 | -- TODO: add rate limiting for failures and raise an error if the function fails 236 | -- at an higher rate. 237 | -- 238 | miningLoop :: (TargetBytes -> HeaderBytes -> RIO Env HeaderBytes) -> RIO Env () 239 | miningLoop inner = mask go 240 | where 241 | go :: (RIO Env () -> RIO Env a) -> RIO Env () 242 | go umask = (forever (umask loopBody) `catches` handlers) >>= \case 243 | Irrecoverable -> pure () 244 | Recoverable -> do 245 | threadDelay 1_000_000 246 | go umask 247 | NodeSwitch -> do 248 | threadDelay 1_000_000 249 | switchWork >>= \x -> when x (go umask) 250 | where 251 | handlers = 252 | [ Handler $ \(e :: IOException) -> do 253 | logError (display e) 254 | pure Irrecoverable 255 | , Handler $ \(e :: UpdateFailure) -> do 256 | logWarn "Update stream failed. Switching nodes ..." 257 | logDebug $ display e 258 | pure NodeSwitch 259 | , Handler $ \(e :: GetWorkFailure) -> do 260 | logWarn "Failed to fetch work! Switching nodes..." 261 | logDebug $ display e 262 | pure NodeSwitch 263 | , Handler $ \(e :: SomeException) -> do 264 | logWarn "Some general error in mining loop. Trying again..." 265 | logDebug $ display e 266 | pure Recoverable 267 | ] 268 | 269 | switchWork = do 270 | e <- ask 271 | urls <- readIORef $ envUrls e 272 | case NEL.nonEmpty $ NEL.tail urls of 273 | Nothing -> do 274 | logError "No nodes left!" 275 | return False 276 | Just rest -> do 277 | clearUpdateMap =<< asks envUpdateMap 278 | writeIORef (envUrls e) rest 279 | return True 280 | 281 | loopBody :: RIO Env () 282 | loopBody = do 283 | T2 w key <- getWork 284 | T3 cbytes tbytes hbytes <- runGet unWorkBytes $ _workBytes w 285 | cid <- liftIO $ chainInt cbytes 286 | logDebug . display . T.pack $ printf "Chain %d: Start mining on new work item." cid 287 | withPreemption key (inner tbytes hbytes) >>= \case 288 | Right a -> miningSuccess w a 289 | Left () -> logDebug "Mining loop was preempted. Getting updated work ..." 290 | where 291 | -- | If the `go` call won the `race`, this function yields the result back 292 | -- to some "mining coordinator" (likely a chainweb-node). 293 | -- 294 | miningSuccess :: WorkBytes -> HeaderBytes -> RIO Env () 295 | miningSuccess w h = do 296 | e <- ask 297 | secs <- readIORef (envSecs e) 298 | hashes <- readIORef (envHashes e) 299 | before <- readIORef (envLastSuccess e) 300 | now <- liftIO getPOSIXTime 301 | writeIORef (envLastSuccess e) now 302 | let !m = envMgr e 303 | !r = (fromIntegral hashes :: Double) / max 1 (fromIntegral secs) / 1000000 304 | !d = ceiling (now - before) :: Int 305 | T3 cbytes _ hbytes <- runGet unWorkBytes $ _workBytes w 306 | cid <- liftIO $ chainInt cbytes 307 | hgh <- liftIO $ height hbytes 308 | logInfo . display . T.pack $ 309 | printf "Chain %d: Mined block at Height %d. (%.2f MH/s - %ds since last)" cid hgh r d 310 | T2 url v <- NEL.head <$> readIORef (envUrls e) 311 | res <- liftIO . runClientM (solvedClient v h) $ mkClientEnv m url 312 | when (isLeft res) $ logWarn "Failed to submit new BlockHeader!" 313 | where 314 | 315 | cpu :: CPUEnv -> TargetBytes -> HeaderBytes -> RIO Env HeaderBytes 316 | cpu cpue tbytes hbytes = do 317 | !start <- liftIO getPOSIXTime 318 | e <- ask 319 | wh <- getWorkHeader 320 | T2 _ v <- NEL.head <$> readIORef (envUrls e) 321 | T2 new ns <- liftIO . fmap head . withScheduler comp $ \sch -> 322 | replicateWork (fromIntegral $ cores cpue) sch $ do 323 | -- TODO Be more clever about the Nonce that's picked to ensure that 324 | -- there won't be any overlap? 325 | n <- Nonce <$> MWC.uniform (envGen e) 326 | new <- usePowHash v $ \(_ :: Proxy a) -> mine @a n wh 327 | terminateWith sch $ getSolved new 328 | !end <- liftIO getPOSIXTime 329 | modifyIORef' (envHashes e) $ \hashes -> ns * fromIntegral (cores cpue) + hashes 330 | modifyIORef' (envSecs e) (\secs -> secs + ceiling (end - start)) 331 | pure new 332 | where 333 | comp :: Comp 334 | comp = case cores cpue of 335 | 1 -> Seq 336 | n -> ParN n 337 | 338 | getWorkHeader = runGet unsafeDecodeWorkHeader 339 | $ "\0\0" <> (_targetBytes tbytes) <> (_headerBytes hbytes) 340 | 341 | getSolved (T2 a b) = T2 (HeaderBytes $ runPutS $ encodeSolvedWork a) b 342 | 343 | gpu :: GPUEnv -> TargetBytes -> HeaderBytes -> RIO Env HeaderBytes 344 | gpu ge@(GPUEnv mpath margs) t@(TargetBytes target) h@(HeaderBytes blockbytes) = do 345 | minerPath <- liftIO . Path.makeAbsolute . Path.fromFilePath $ T.unpack mpath 346 | e <- ask 347 | res <- liftIO $ callExternalMiner minerPath (map T.unpack margs) False target blockbytes 348 | case res of 349 | Left err -> do 350 | logError . display . T.pack $ "Error running GPU miner: " <> err 351 | throwString err 352 | Right (MiningResult nonceBytes numNonces hps _) -> do 353 | let secs = numNonces `div` max 1 hps 354 | case checkNonce (B.take (B.length blockbytes - 8) blockbytes <> nonceBytes) of 355 | Nothing -> do 356 | logError "Bad nonce returned from GPU!" 357 | gpu ge t h 358 | Just newBytes -> do 359 | modifyIORef' (envHashes e) (+ numNonces) 360 | modifyIORef' (envSecs e) (+ secs) 361 | pure $! HeaderBytes newBytes 362 | where 363 | checkNonce newBytes = do 364 | bh <- runGet decodeBlockHeaderWithoutHash newBytes 365 | guard (prop_block_pow bh) 366 | return newBytes 367 | 368 | -- -------------------------------------------------------------------------- -- 369 | -- Utils 370 | 371 | unWorkBytes :: MonadGet m => m (T3 ChainBytes TargetBytes HeaderBytes) 372 | unWorkBytes = T3 373 | <$> (ChainBytes <$> getBytes 4) 374 | <*> (TargetBytes <$> getBytes 32) 375 | <*> do 376 | l <- fromIntegral <$> remaining 377 | HeaderBytes <$> getByteString l 378 | 379 | unsafeDecodeWorkHeader :: MonadGet m => m WorkHeader 380 | unsafeDecodeWorkHeader = WorkHeader 381 | <$> decodeChainId 382 | <*> decodeHashTarget 383 | <*> do 384 | l <- fromIntegral <$> remaining 385 | BS.toShort <$> getByteString l 386 | 387 | chain :: MonadThrow m => MonadIO m => ChainBytes -> m ChainId 388 | chain (ChainBytes cbs) = runGet decodeChainId cbs 389 | 390 | chainInt :: MonadThrow m => MonadIO m => ChainBytes -> m Int 391 | chainInt c = chainIdInt <$> chain c 392 | 393 | height :: MonadThrow m => MonadIO m => HeaderBytes -> m Word64 394 | height (HeaderBytes hbs) = _height <$> runGet decodeBlockHeight (B.take 8 $ B.drop 258 hbs) 395 | -------------------------------------------------------------------------------- /exec/Miner/Balance.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE TypeApplications #-} 4 | {-# LANGUAGE TypeApplications #-} 5 | 6 | module Miner.Balance ( getBalances ) where 7 | 8 | import Data.Aeson (Value(..)) 9 | import Data.Decimal (Decimal, roundTo) 10 | import qualified Data.DList as D 11 | import Data.Semigroup.Foldable 12 | import Data.These (These(..)) 13 | import Data.Time.Clock.POSIX (getPOSIXTime) 14 | import Network.HTTP.Client 15 | import Network.HTTP.Client.TLS 16 | import RIO 17 | import qualified RIO.List as L 18 | import qualified RIO.NonEmpty.Partial as NEL 19 | import qualified RIO.Text as T 20 | import Servant.Client 21 | import Text.Printf (printf) 22 | 23 | -- internal modules 24 | 25 | import Chainweb.ChainId (chainIdFromText) 26 | import Chainweb.Pact.RestAPI.Client (pactLocalApiClient) 27 | import Chainweb.RestAPI.NodeInfo (NodeInfo(..), NodeInfoApi) 28 | import Chainweb.Utils (sshow) 29 | import Miner.Types (tlsSettings) 30 | import qualified Pact.ApiReq as P 31 | import qualified Pact.Types.ChainId as P 32 | import qualified Pact.Types.ChainMeta as P 33 | import qualified Pact.Types.Command as P 34 | import qualified Pact.Types.Exp as P 35 | import qualified Pact.Types.Gas as P 36 | import qualified Pact.Types.PactValue as P 37 | 38 | getBalances :: BaseUrl -> Text -> IO () 39 | getBalances url mi = do 40 | balanceStmts <- newManager (mkManagerSettings tlsSettings Nothing) >>= go . cenv 41 | case balanceStmts of 42 | These errors balances -> do 43 | printf "-- Retrieved Balances -- \n" 44 | forM_ balances printer 45 | printf "-- Errors --\n" 46 | forM_ errors errPrinter 47 | This errors -> do 48 | printf "-- Errors --\n" 49 | forM_ errors errPrinter 50 | That balances -> do 51 | printf "-- Retrieved Balances -- \n" 52 | total <- foldM printBalance 0 balances 53 | printf $ "Total => ₭" <> sshow (roundTo 12 total) <> "\n" 54 | where 55 | tx = T.pack $ printf "(coin.get-balance \"%s\")" mi 56 | printer (a, b) = printf $ T.unpack (toBalanceMsg a b) <> ".\n" 57 | errPrinter (a,b) = printf $ T.unpack (toErrMsg a b) <> ".\n" 58 | cenv m = mkClientEnv m url 59 | mConc as f = runConcurrently $ foldMap1 (Concurrently . f) as 60 | 61 | printBalance :: Decimal -> (Text, Decimal) -> IO Decimal 62 | printBalance tot (c, bal) = tot + bal <$ printf (T.unpack (toBalanceMsg c bal) <> "\n") 63 | 64 | meta :: P.ChainId -> P.TxCreationTime -> P.PublicMeta 65 | meta c t = P.PublicMeta 66 | { P._pmChainId = c 67 | , P._pmSender = "" 68 | , P._pmGasLimit = P.GasLimit 1000 69 | , P._pmGasPrice = P.GasPrice 0.00000001 70 | , P._pmTTL = P.TTLSeconds 3600 71 | , P._pmCreationTime = t } 72 | 73 | go :: ClientEnv -> IO (These (D.DList (Text, LocalCmdError)) (D.DList (Text, Decimal))) 74 | go env = do 75 | res <- runClientM (client (RIO.Proxy @NodeInfoApi)) env 76 | NodeInfo v _ cs _ _ <- either (throwString . show) pure res 77 | mConc (NEL.fromList $ L.sort cs) $ \cidtext -> do 78 | c <- chainIdFromText cidtext 79 | t <- txTime 80 | let !met = meta (P.ChainId cidtext) t 81 | cmd <- P.mkExec tx Null met mempty Nothing Nothing 82 | toLocalResult cidtext <$> runClientM (pactLocalApiClient v c cmd) env 83 | 84 | toLocalResult 85 | :: a 86 | -> Either ClientError (P.CommandResult l) 87 | -> These (D.DList (a, LocalCmdError)) (D.DList (a, Decimal)) 88 | toLocalResult c r = case r of 89 | Right res -> convertResult c $ P._crResult res 90 | Left l -> This $ D.singleton (c, Client l) 91 | 92 | convertResult 93 | :: a 94 | -> P.PactResult 95 | -> These (D.DList (a, LocalCmdError)) (D.DList (a, Decimal)) 96 | convertResult c (P.PactResult result) = case result of 97 | Right (P.PLiteral (P.LDecimal bal)) -> That $ D.singleton (c, bal) 98 | Left perr -> This $ D.singleton (c, LookupError (sshow perr)) 99 | Right a -> This $ D.singleton (c, PactResponseError (sshow a)) 100 | 101 | toErrMsg :: Text -> LocalCmdError -> Text 102 | toErrMsg c (Client err) = "Client error on chain " <> c <> ": " <> sshow err 103 | toErrMsg c (LookupError err) = "Balance lookup error on chain: " <> c <> ": " <> err 104 | toErrMsg c (PactResponseError err) = mconcat 105 | [ "Pact result error on chain: " 106 | , sshow c 107 | , ": " 108 | , sshow err 109 | , ". This should never happen. Please raise an issue at " 110 | , "https://github.com/kadena-io/chainweb-node/issues." 111 | ] 112 | 113 | toBalanceMsg :: Text -> Decimal -> Text 114 | toBalanceMsg cidtext bal = "Chain " <> cidtext <> " => " <> "₭" <> sshow (roundTo 12 bal) 115 | 116 | data LocalCmdError = Client ClientError | LookupError Text | PactResponseError Text 117 | 118 | txTime :: IO P.TxCreationTime 119 | txTime = fromInteger . round <$> getPOSIXTime 120 | -------------------------------------------------------------------------------- /exec/Miner/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE DerivingStrategies #-} 5 | {-# LANGUAGE NoImplicitPrelude #-} 6 | {-# LANGUAGE OverloadedStrings #-} 7 | {-# LANGUAGE TypeApplications #-} 8 | 9 | module Miner.Types 10 | ( -- * Runtime Environment 11 | Env(..) 12 | , UpdateMap(..) 13 | , UpdateKey(..) 14 | -- * CLI Flags 15 | , ClientArgs(..) 16 | , pCommand 17 | , Command(..) 18 | , CPUEnv(..) 19 | , GPUEnv(..) 20 | , OtherCommand(..) 21 | -- * miscellaneous 22 | , tlsSettings 23 | ) where 24 | 25 | import Chainweb.Utils (textOption) 26 | import Data.Generics.Product.Fields (field) 27 | import Data.Time.Clock.POSIX (POSIXTime) 28 | import Data.Tuple.Strict (T2(..)) 29 | import Network.Connection 30 | import Network.HTTP.Client hiding (Proxy(..), responseBody) 31 | import Options.Applicative 32 | import RIO 33 | import RIO.Char (isHexDigit) 34 | import qualified RIO.HashMap as HM 35 | import qualified RIO.Set as S 36 | import qualified RIO.Text as T 37 | import Servant.Client 38 | import qualified System.Random.MWC as MWC 39 | 40 | -- internal modules 41 | 42 | import Chainweb.HostAddress (HostAddress, hostAddressToBaseUrl) 43 | import Chainweb.Miner.Pact (Miner(..), MinerKeys(..)) 44 | import Chainweb.Version (ChainId, ChainwebVersion) 45 | import qualified Pact.Types.Info as P 46 | import qualified Pact.Types.Term as P 47 | 48 | -------------------------------------------------------------------------------- 49 | -- Updates 50 | 51 | newtype UpdateKey = UpdateKey { _updateKeyChainId :: ChainId } 52 | deriving stock (Show, Eq, Ord, Generic) 53 | deriving anyclass (Hashable) 54 | 55 | newtype UpdateMap = UpdateMap 56 | { _updateMap :: MVar (HM.HashMap UpdateKey (T2 (TVar Int) (Async ()))) 57 | } 58 | 59 | -------------------------------------------------------------------------------- 60 | -- Runtime Environment 61 | 62 | data Env = Env 63 | { envGen :: !MWC.GenIO 64 | , envMgr :: !Manager 65 | , envLog :: !LogFunc 66 | , envCmd :: !Command 67 | , envArgs :: !ClientArgs 68 | , envHashes :: IORef Word64 69 | , envSecs :: IORef Word64 70 | , envLastSuccess :: IORef POSIXTime 71 | , envUpdateMap :: !UpdateMap 72 | , envUrls :: IORef (NonEmpty (T2 BaseUrl ChainwebVersion)) } 73 | deriving stock (Generic) 74 | 75 | instance HasLogFunc Env where 76 | logFuncL = field @"envLog" 77 | 78 | -------------------------------------------------------------------------------- 79 | -- CLI Flags 80 | 81 | -- | Result of parsing commandline flags. 82 | -- 83 | data ClientArgs = ClientArgs 84 | { ll :: !LogLevel 85 | , coordinators :: ![BaseUrl] 86 | , miner :: !Miner 87 | , chainid :: !(Maybe ChainId) } 88 | deriving stock (Generic) 89 | 90 | -- | The top-level git-style CLI "command" which determines which mining 91 | -- paradigm to follow. 92 | -- 93 | data Command = CPU CPUEnv ClientArgs | GPU GPUEnv ClientArgs | Otherwise OtherCommand 94 | 95 | newtype CPUEnv = CPUEnv { cores :: Word16 } 96 | 97 | data GPUEnv = GPUEnv 98 | { envMinerPath :: Text 99 | , envMinerArgs :: [Text] 100 | } deriving stock (Generic) 101 | 102 | pClientArgs :: Parser ClientArgs 103 | pClientArgs = ClientArgs <$> pLog <*> some pUrl <*> pMiner <*> pChainId 104 | 105 | pCommand :: Parser Command 106 | pCommand = hsubparser 107 | ( command "cpu" (info cpuOpts (progDesc "Perform multicore CPU mining")) 108 | <> command "gpu" (info gpuOpts (progDesc "Perform GPU mining")) 109 | <> command "keys" (info (Otherwise <$> keysOpts) (progDesc "Generate public/private key pair")) 110 | <> command "balance" (info (Otherwise <$> balancesOpts) (progDesc "Get balances on all chains")) 111 | ) 112 | 113 | pMinerPath :: Parser Text 114 | pMinerPath = textOption 115 | (long "miner-path" <> help "Path to chainweb-gpu-miner executable") 116 | 117 | pMinerArgs :: Parser [Text] 118 | pMinerArgs = T.words <$> pMinerArgs0 119 | where 120 | pMinerArgs0 :: Parser T.Text 121 | pMinerArgs0 = textOption 122 | (long "miner-args" <> value "" <> help "Extra miner arguments") 123 | 124 | pGpuEnv :: Parser GPUEnv 125 | pGpuEnv = GPUEnv <$> pMinerPath <*> pMinerArgs 126 | 127 | gpuOpts :: Parser Command 128 | gpuOpts = liftA2 GPU pGpuEnv pClientArgs 129 | 130 | cpuOpts :: Parser Command 131 | cpuOpts = liftA2 (CPU . CPUEnv) pCores pClientArgs 132 | 133 | pCores :: Parser Word16 134 | pCores = option auto 135 | (long "cores" <> metavar "COUNT" <> value 1 136 | <> help "Number of CPU cores to use (default: 1)") 137 | 138 | pLog :: Parser LogLevel 139 | pLog = option (eitherReader l) 140 | (long "log-level" <> metavar "debug|info|warn|error" <> value LevelInfo 141 | <> help "The minimum level of log messages to display (default: info)") 142 | where 143 | l :: String -> Either String LogLevel 144 | l "debug" = Right LevelDebug 145 | l "info" = Right LevelInfo 146 | l "warn" = Right LevelWarn 147 | l "error" = Right LevelError 148 | l _ = Left "Must be one of debug|info|warn|error" 149 | 150 | pUrl :: Parser BaseUrl 151 | pUrl = hostAddressToBaseUrl Https <$> hadd 152 | where 153 | hadd :: Parser HostAddress 154 | hadd = textOption 155 | (long "node" <> metavar "" 156 | <> help "Remote address of Chainweb Node to send mining results to") 157 | 158 | pChainId :: Parser (Maybe ChainId) 159 | pChainId = optional $ textOption 160 | (long "chain" <> metavar "CHAIN-ID" 161 | <> help "Prioritize work requests for a specific chain") 162 | 163 | pMiner :: Parser Miner 164 | pMiner = Miner 165 | <$> strOption (long "miner-account" <> help "Coin Contract account name of Miner") 166 | <*> (MinerKeys <$> pks) 167 | where 168 | pks :: Parser P.KeySet 169 | pks = P.KeySet <$> fmap S.fromList (some pKey) <*> pPred 170 | 171 | pKey :: Parser P.PublicKey 172 | pKey = option k (long "miner-key" 173 | <> help "Public key of the account to send rewards (can pass multiple times)") 174 | where 175 | k :: ReadM P.PublicKey 176 | k = eitherReader $ \s -> do 177 | unless (length s == 64 && all isHexDigit s) 178 | . Left $ "Public Key " <> s <> " is not valid." 179 | Right $ fromString s 180 | 181 | pPred :: Parser P.Name 182 | pPred = (\s -> P.Name . P.BareName s $ P.Info Nothing) <$> 183 | strOption (long "miner-pred" <> value "keys-all" <> help "Keyset predicate") 184 | 185 | data OtherCommand = 186 | Keys | Balance BaseUrl Text 187 | 188 | keysOpts :: Parser OtherCommand 189 | keysOpts = pure Keys 190 | 191 | balancesOpts :: Parser OtherCommand 192 | balancesOpts = Balance <$> pUrl <*> pMinerName 193 | where 194 | pMinerName :: Parser Text 195 | pMinerName = 196 | textOption (long "miner-account" <> help "Account name to check the balance of") 197 | 198 | -- | This allows this code to accept the self-signed certificates from 199 | -- `chainweb-node`. 200 | -- 201 | tlsSettings :: TLSSettings 202 | tlsSettings = TLSSettingsSimple True True True 203 | -------------------------------------------------------------------------------- /exec/Miner/Updates.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DerivingStrategies #-} 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 3 | {-# LANGUAGE LambdaCase #-} 4 | {-# LANGUAGE NoImplicitPrelude #-} 5 | {-# LANGUAGE NumericUnderscores #-} 6 | {-# LANGUAGE OverloadedStrings #-} 7 | 8 | module Miner.Updates 9 | ( newUpdateMap 10 | , withPreemption 11 | , clearUpdateMap 12 | , UpdateFailure(..) 13 | ) where 14 | 15 | import Data.Tuple.Strict (T2(..)) 16 | 17 | import Network.HTTP.Client hiding (Proxy(..), responseBody) 18 | import qualified Network.HTTP.Client as HTTP 19 | import Network.Wai.EventSource (ServerEvent(..)) 20 | import Network.Wai.EventSource.Streaming (withEvents) 21 | 22 | import RIO 23 | import qualified RIO.HashMap as HM 24 | import qualified RIO.NonEmpty as NEL 25 | import qualified RIO.Text as T 26 | 27 | import Servant.Client 28 | 29 | import qualified Streaming.Prelude as SP 30 | 31 | -- internal modules 32 | 33 | import Chainweb.Utils (runPut, toText) 34 | import Chainweb.Version (ChainId, ChainwebVersion, encodeChainId) 35 | import Miner.Types (Env(..), UpdateKey(..), UpdateMap(..)) 36 | 37 | -- -------------------------------------------------------------------------- -- 38 | -- Internal Trigger Type 39 | 40 | data Reason = Timeout | Update | StreamClosed | StreamFailed SomeException 41 | deriving (Show) 42 | 43 | newtype Trigger = Trigger (STM Reason) 44 | 45 | awaitTrigger :: MonadIO m => Trigger -> m Reason 46 | awaitTrigger (Trigger t) = atomically t 47 | 48 | -- -------------------------------------------------------------------------- -- 49 | -- Update Map API 50 | 51 | newtype UpdateFailure = UpdateFailure T.Text 52 | deriving (Show, Eq, Ord, Display) 53 | 54 | instance Exception UpdateFailure 55 | 56 | -- | Creates a map that maintains one upstream for each chain 57 | -- 58 | newUpdateMap :: IO UpdateMap 59 | newUpdateMap = UpdateMap <$> newMVar mempty 60 | 61 | -- | Reset all update streams in the map. 62 | -- 63 | clearUpdateMap :: MonadUnliftIO m => UpdateMap -> m () 64 | clearUpdateMap (UpdateMap um) = modifyMVar um $ \m -> do 65 | mapM_ (\(T2 _ a) -> cancel a) m 66 | return mempty 67 | 68 | getTrigger :: UpdateMap -> UpdateKey -> RIO Env Trigger 69 | getTrigger (UpdateMap v) k = modifyMVar v $ \m -> case HM.lookup k m of 70 | 71 | -- If there exists already an update stream, check that it's live, and 72 | -- restart if necessary. 73 | -- 74 | Just x -> do 75 | n@(T2 var a) <- checkStream x 76 | t <- newTrigger var a 77 | return (HM.insert k n m, t) 78 | 79 | -- If there isn't an update stream in the map, create a new one. 80 | -- 81 | Nothing -> do 82 | n@(T2 var a) <- newTVarIO 0 >>= newUpdateStream 83 | t <- newTrigger var a 84 | return (HM.insert k n m, t) 85 | where 86 | checkStream :: T2 (TVar Int) (Async ()) -> RIO Env (T2 (TVar Int) (Async ())) 87 | checkStream (T2 var a) = poll a >>= \case 88 | Nothing -> return (T2 var a) 89 | Just (Left _) -> newUpdateStream var -- TODO logging, throttling 90 | Just (Right _) -> newUpdateStream var 91 | 92 | newUpdateStream :: TVar Int -> RIO Env (T2 (TVar Int) (Async ())) 93 | newUpdateStream var = T2 var 94 | <$!> async (updateStream (_updateKeyChainId k) var) 95 | 96 | -- There are three possible outcomes 97 | -- 98 | newTrigger :: TVar Int -> Async () -> RIO Env Trigger 99 | newTrigger var a = do 100 | cur <- readTVarIO var 101 | timeoutVar <- registerDelay (5 * 30_000_000) 102 | -- 5 times the block time ~ 0.7% of all blocks. This for detecting if 103 | -- a stream gets stale without failing. 104 | 105 | return $ Trigger $ pollSTM a >>= \case 106 | Just (Right ()) -> return StreamClosed 107 | Just (Left e) -> return $ StreamFailed e 108 | Nothing -> do 109 | isTimeout <- readTVar timeoutVar 110 | isUpdate <- (/= cur) <$> readTVar var 111 | unless (isTimeout || isUpdate) retrySTM 112 | return Update 113 | 114 | -- | Run an operation that is preempted if an update event occurs. 115 | -- 116 | -- Streams are restarted automatically, when they got closed by the server. We 117 | -- don't restart streams automatically in case of a failure, but instead throw 118 | -- an exception. Failures are supposed to be handled in the outer mining 119 | -- functions. 120 | -- 121 | -- There is risk that a stream stalls without explicitely failing. We solve this 122 | -- by preempting the loop if we haven't seen an update after 5 times the block 123 | -- time (which will affect about 0.7% of all blocks). 124 | -- 125 | withPreemption :: UpdateKey -> RIO Env a -> RIO Env (Either () a) 126 | withPreemption k = race awaitChange 127 | where 128 | awaitChange = do 129 | m <- asks envUpdateMap 130 | trigger <- getTrigger m k 131 | awaitTrigger trigger >>= \case 132 | StreamClosed -> awaitChange 133 | StreamFailed e -> throwM $ UpdateFailure $ "update stream failed: " <> errMsg e 134 | Timeout -> throwM $ UpdateFailure "timeout of update stream" 135 | Update -> return () 136 | 137 | errMsg e = case fromException e of 138 | Just (HTTP.HttpExceptionRequest _ ex) -> T.pack $ show ex 139 | _ -> T.pack $ show e 140 | 141 | -- | Atomatically restarts the stream when the response status is 2** and throws 142 | -- and exception otherwise. 143 | -- 144 | updateStream :: ChainId -> TVar Int -> RIO Env () 145 | updateStream cid var = do 146 | e <- ask 147 | u <- NEL.head <$> readIORef (envUrls e) -- Do we ever use something else than the head? 148 | liftIO $ withEvents (req u) (envMgr e) $ \updates -> updates 149 | & SP.filter realEvent 150 | & SP.mapM_ (\_ -> atomically $ modifyTVar' var (+ 1)) 151 | where 152 | realEvent :: ServerEvent -> Bool 153 | realEvent ServerEvent{} = True 154 | realEvent _ = False 155 | 156 | req :: T2 BaseUrl ChainwebVersion -> Request 157 | req (T2 u v) = defaultRequest 158 | { host = encodeUtf8 . T.pack . baseUrlHost $ u 159 | , path = "chainweb/0.0/" <> encodeUtf8 (toText v) <> "/mining/updates" 160 | , port = baseUrlPort u 161 | , secure = True 162 | , method = "GET" 163 | , requestBody = RequestBodyBS $ runPut (encodeChainId cid) 164 | , responseTimeout = responseTimeoutNone 165 | , checkResponse = throwErrorStatusCodes 166 | } 167 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-16.0 2 | 3 | extra-deps: 4 | # --- Missing from Stackage --- # 5 | - bloomfilter-2.0.1.0 6 | - configuration-tools-0.5.0 7 | - digraph-0.2 8 | - fake-0.1.1.3 9 | - ixset-typed-0.5 10 | - loglevel-0.1.0.0 11 | - merkle-log-0.1.0.0 12 | - paths-0.2.0.0 13 | - random-strings-0.1.1.0 14 | - streaming-concurrency-0.3.1.3 15 | - streaming-events-1.0.0 16 | - streaming-with-0.2.2.1 17 | - strict-tuple-0.1.3 18 | - tasty-json-0.1.0.0 19 | - these-skinny-0.7.4 20 | - token-bucket-0.1.0.1 21 | - wai-middleware-throttle-0.3.0.1 22 | - yet-another-logger-0.4.0 23 | 24 | # --- Forced Downgrades --- # 25 | - network-3.1.0.1 26 | 27 | # --- Transitive Pact Dependencies --- # 28 | - direct-sqlite-2.3.26 29 | - ed25519-donna-0.1.1 30 | - prettyprinter-1.6.0 31 | - sbv-8.6 32 | - github: kadena-io/thyme 33 | commit: 6ee9fcb026ebdb49b810802a981d166680d867c9 34 | 35 | # --- Custom Pins --- # 36 | - github: kadena-io/chainweb-node 37 | commit: be3d78afb18934e5268d2f95ab9a69226750f0f3 38 | - github: kadena-io/pact 39 | commit: 2ca4cae3eb8a0ef2783aa9457388c31b44a0dfbc 40 | - github: kadena-io/chainweb-storage 41 | commit: 07e7eb7596c7105aee42dbdb6edd10e3f23c0d7e 42 | - github: kadena-io/rosetta 43 | commit: 1ccb68d7aec0414f494fb06f591214e7cf845627 44 | 45 | --------------------------------------------------------------------------------