finddataoperations({
- `target [UINT32] (default = null)`
The account that received the DATA operation. Optional.
- `guid [GUID] (default = null)`
- A 16 Bytes GUID in `8-4-4-4-12` format. Optional.
+ A 16 Bytes GUID in `{8-4-4-4-12}` format. Optional.
+ Note that in Pascal programming language GUID is wrapped in {} brackets. Example: {E7213C38-1A97-4CCA-A200-1FF094639BF5}. Brackets {} do not affect the blockchain, but {} should be part of GUID passed to JSON RPC API calls.
- `data_sequence [UINT16]`
The data sequence of the operation to search for. Optional.
- `data_type [UINT16]`
@@ -229,3 +232,5 @@ None.
- UUID V4: https://en.wikipedia.org/wiki/Universally_unique_identifier#Version_4_(random)
- PascalCoin JSON RPC documentation: https://github.com/PascalCoin/PascalCoin/wiki/JSON-RPC-API
+
+- DATA-OP: In-Protocol Data Exchange (Layer-2 support) https://www.pascalcoin.org/development/pips/pip-0016
diff --git a/PIP/PIP-0041.md b/PIP/PIP-0041.md
new file mode 100644
index 000000000..b2c5cf393
--- /dev/null
+++ b/PIP/PIP-0041.md
@@ -0,0 +1,90 @@
+
+ PIP: PIP-0041
+ Title: Pay To Key: in-protocol PASA distribution
+ Type: Protocol
+ Impact: Hard-Fork
+ Author: Herman Schoenfeld
+ Comments-URI: https://discord.gg/sJqcgtD (channel #pip-0041)
+ Status: Draft
+ Created: 2020-10-26
+
+
+## Summary
+
+This PIP proposes solution to a fundamental problem in PascalCoin; how first-time users get their first account.
+
+## Motivation
+
+One of the issues with PascalCoin is that new users require an account (PASA) before they can receive PASC. This is known as the "first PASA problem" and is an chicken-and-egg type problem. In all other cryptocurrencies, first-time users can receive their first coins simply by giving the sender their "address". In PascalCoin, a new user that wants to receive PASC for the first time is unable to give an address because they do not have an account. Instead, they must first acquire an account. This process typically comprises of them scratching their head, searching the internet for information, learning about PASA's and eventually contacting a 3rd party PASA dispenser (like [FreePasa.org](https://freepasa.org)) to get their account. Only after all that and waiting 5 minutes for a blockchain confirmation can they finally possess an address to give the sender in order to receive their PASC.
+
+Almost all user feedback on this workflow has been highly negative. Attempts to solve this issue (as Blaise app does) are still a bad user experience and overtly complex. It's a well known principle of product design that onboarding new users should always be as easy and smooth as possible in order maximize the market penetration of that product. Thus it is clear that the "first PASA problem" is an impediment to PascalCoin's growth and needs to be solved.
+
+This PIP finally solves this problem. It provides first time users an **instant** receive address they can use immediately, just like Bitcoin. This is achieved through the use of E-PASA, Block Policy and a Buy Account operation. In this proposal, all users will be able to receive funds directly to their public key by virtue of an E-PASA of the form **@[1BvBMSEYstWetqTFn5Au4m4GFg7xJaNVN2]**. Here the users public key is encoded in base-58 within square brackets pre-fixed with an @ symbol.
+
+A transaction to such an E-PASA is translated under-the-hood as a "Buy Account" operation for **any floating** account available in the SafeBox. Floating accounts are very similar to "Public Sale Accounts" except they are owned by no one and have no seller. The "sale price" for floating accounts is determined by an economic variable in the Block Policy called "New PASA Fee". This fee is "floating" in that it can change with the block policy. This allows the price of new PASA to always be low enough to onboard new users but high enough to dissuade hoarding and abuse. This value is determined by the PascalCoin community through a layer-1 governance system called [Block Policy][2].
+
+From the senders perspective, this solution requires no change to their workflow. With the implementation of E-PASA, when sending transactions the sender can enter an E-PASA recipient. Thus, by simply entering an E-PASA of the form described above, the PascalCoin node can automatically produce a "Pay to key" style Buy Account operation under-the-hood. Thus it allows a sender to sent to a recipient's account or key, as they desire. This is also true at the API-level where the API sender is an E-PASA and can perform a Pay to Key by virtue of the recipient's address alone without any other details.
+
+## Specification
+
+### 1. Core Changes
+
+#### 1.1 BuyAccount Operation Changes
+
+A. New transaction sub-type called "buy floating account".
+
+B. Implements same logic as "buy account" except for the following changes:
+
+ B.1. The "account to buy" is 0 and ignored
+
+ B.2. The "account to pay" is 0 and ignored (i.e. sellers account)
+
+C. On execution,
+
+ C.1 The **first** PASA in the SafeBox with type "Floating" is selected as the "account to buy"
+
+ C.2 The "Sale Price" for C.1 is taken from the Block Policy variable "New PASA Fee"
+
+ C.3 The account is purchased in exactly the same manner as Buy Account except "account to pay" is credited 0 PASC (i.e. the New PASA Fee is **burned**).
+
+#### 1.2 JSON API
+
+A. New method called “Pay to Key” is offered that works as follows:
+
+ A.1 Arguments are Account, Public Key, Quantity
+
+ A.2 Builds a "Buy Floating Account" operation as per (1.1) using arguments in (A.1)
+
+
+B. Update "SendTransaction" method such that,
+
+ B.1 If target E-PASA is of the form *"@[Base58Key]"* then B.2 else B.3
+
+ B.2 Route to "Pay To Key" method using the parsed Base58Key as buyers key, keeping other arguments unchanged then finish
+
+ B.3 Continue as a normal SendTransaction
+
+### GUI Changes
+
+No changes are required since this feature is enabled with E-PASA support (PIP-0027). A pay to key will occur under-the-hood when someone sends a transaction to "@[1BvBMSEYstWetqTFn5Au4m4GFg7xJaNVN2]" address.
+
+## Rationale
+
+The design approach is to provide a pure in-protocol PASA distribution solution for first time users. The design also is seamless in that a new operation is not required and minimizes implementation complexity as it leverages existing and other proposed new features.
+
+This proposal definitively solves the first-PASA problem and provides an in-protocol distribution mechanism for PASA's whilst maintaining the commoditization principles that made PASA's great to begin with.
+
+Also, there will be no need for 3rd party infrastructure FreePasa.org or GetPasa.com and the hundreds of thousands of accounts available to Foundation can be made floating. Also with Block Policy, all new PASA's are by default set to floating (except the miner/dev reward ones).
+
+## Backwards Compatibility
+
+This PIP is not backwards compatible and requires a hard-fork activation. It also requires [PIP-0027 E-PASA][1] and [PIP-0035 Block Policy][2] activation.
+
+## Links
+
+1. [E-PASA: Infinite Address-Space (via Layer-2)][1]
+2. [Block Policy: Layer-1 Governance][2]
+
+[1]: https://github.com/PascalCoin/PascalCoin/blob/master/PIP/PIP-0027.md
+[2]: https://github.com/PascalCoin/PascalCoin/blob/master/PIP/PIP-0035.md
+
diff --git a/PIP/PIP-0042.md b/PIP/PIP-0042.md
new file mode 100644
index 000000000..6ce668539
--- /dev/null
+++ b/PIP/PIP-0042.md
@@ -0,0 +1,152 @@
+
+ PIP: PIP-0042
+ Title: Update OP_RECOVER to initial sense described on original WhitePaper and allow ASK FOR PASA feature
+ Type: Protocol
+ Impact: Hard-Fork
+ Author: Albert Molina
+ Copyright: Albert Molina, 2021 (All Rights Reserved)
+ Comments-URI: https://discord.gg/gamPX9E4RF (Discord channel #pip-42)
+ Status: Proposed
+ Created: 2021-09-23
+
+
+## Summary
+
+Update current OP_RECOVER operation in order to have a similar sense as described on [Original PascalCoin WhitePaper published on July 2016][1] few weeks before Genesis Block.
+
+## Motivation
+
+OP_RECOVER feature was defined on original PascalCoin Whitepaper published on July 2016 as a way to allow recover coins that has lost private key.
+
+**PascalCoin WhitePaper:**
+```
+PascalCoin proposes an alternative to the basic operation of Bitcoin, through which change
+several aspects for working on the new virtual currency:
+...
+ - PascalCoin provides a method set by protocol to retrieve coins that are not used
+ instead (lost key). This method only applies if after a certain time the owner does not
+ make any operation with the account private key.
+...
+(Page 2/8)
+```
+
+Basically was a way to mantain a constant and predectible inflation and available coin because burning coins are not possible.
+
+Current problem is that WhitePaper definition is ambiguous and **certain time** was not specified, initial source code proposal was to **set a time value = 4 years** (420480 blocks in PascalCoin)
+
+Another problem is that WhitePaper didn't specified who can retrieve coins that are not used, neither what to do with Pascal Accounts (aka **PASA**) not used.
+
+## Proposal
+
+This PIP specifies a more accurated OP_RECOVER feature that will mantain initial sense and will allow a fair PASA and coins distribution.
+
+Update current OP_RECOVER to work as this:
+
+1. The way to know if an Account is not used will be counting how many blocks since last private key signed this Account as an Active mode as defined on [PIP-0037][2].
+
+2. Accounts without coins (amount = 0) can be reused to community usage in a ASK FOR PASA (OP_RECOVER special case) after 4 years if Account has not been used as specified on 1.
+
+3. Coins stored in Accounts (where amount > 0) can be retrieved to MINER that generates a block as a fee in the OP_RECOVER operation after 10 years if Account has not been used as specified on 1.
+
+4. ASK FOR PASA will be an OP_RECOVER special case operation signed by an Authority Account, Authority Account will be the Account stored in the type value of Account number 1 ( Account(1).type == Authority Account ).
+
+5. Accounts 0 to 9 (inclusive) are exempt for OP_RECOVER operation.
+
+
+## Specification
+
+The following changes are required to implement this in PascalCoin.
+
+### New OP_RECOVER fields
+
+A new field `sign` will be added to OP_RECOVER that will be used in Proposal number 2. Value MUST be empty in other cases.
+
+```
+ TOpRecoverFoundsData = Record
+ account: Cardinal;
+ n_operation : Cardinal;
+ fee: UInt64;
+ new_publicKey: TAccountKey;
+ // New field for PIP-0042
+ sign: TECDSA_SIG;
+ End;
+```
+
+### Update OP_RECOVER code
+
+#### Changes on check
+
+Check proposals 2 to 5:
+
+```
+ let A = target PASA
+ let L4Years = 420480 ((24 hours * 60 minutes) DIV 5 minutes) * 365 days * 4 years)
+ let L10Years = 1051200 ((24 hours * 60 minutes) DIV 5 minutes) * 365 days * 10 years)
+ let LCurrentBlock = Current Blockchain new block number
+
+ // Proposal 5 protection
+ if (A.account<=9) then
+ Error 'Accounts 0..9 are protected';
+
+ // Proposal 2 protection
+ if (A.updated_on_block_active_mode + L4Years >= LCurrentBlock) then
+ Error 'Account is still active (less than 4 years without private key usage)';
+
+ // Proposal 3 protection
+ if (A.updated_on_block_active_mode + L10Years >= LCurrentBlock) AND (A.Balance > 0) then
+ Error 'Account has balance>0 and still active (less than 10 years without private key usage)';
+
+ let B = Account(1)
+ let C = Account( B.type ) // Authority account
+ let DATA = OP_RECOVER fields
+
+ // Proposal 4 ASK FOR PASA signed by Authority account
+ if ((DATA.new_publicKey) not null) AND (NOT IsValidSignature(DATA.sign, C.accountInfo.publicKey)) then
+ Error 'Ask for Pasa feature must be signed by Authority account';
+
+```
+
+#### Changes on Execute
+
+Execution is done only **after checks are passed**
+
+```
+ // Assume same fields than check code
+
+ // Ask for Pasa
+ if ((DATA.new_publicKey) not null) then
+ set A.accountInfo.publicKey = DATA.new_publicKey
+
+ set FEE = A.balance
+ set A.balance = 0; // Sets Account balance to 0, balance will be a fee for the miner
+
+ SaveAccount( A );
+
+ // Only the miner will obtain coins as a Fee of the block, none other can retrieve coins
+ IncrementNewBlockFee( FEE );
+
+```
+
+### Conclusion
+
+Only miner can retrieve coins, this will help and add a miners and pools race
+
+Current holders will have a reasonable time period (10 years) to hold coins
+
+Ask for Pasa feature will be available since activation thanks to 4 years rule
+
+## Affected PIP's
+
+This PIP deactivates PIP-0012 and PIP-0019
+
+## Backwards Compatibility
+
+This change is not backwards compatible and requires a hard-fork activation.
+
+## Links
+
+1. [Original PascalCoin WhitePaper published on July 2016. Accessed 2021-09.][1]
+2. [PIP-0037][2]
+
+[1]: https://github.com/PascalCoin/PascalCoin/blob/c22184dd7a407c6646ab651494822071726ed36e/PascalCoin%20White%20Paper%20-%20EN.pdf
+[2]: https://github.com/PascalCoin/PascalCoin/blob/master/PIP/PIP-0037.md
diff --git a/PIP/PIP-0043.md b/PIP/PIP-0043.md
new file mode 100644
index 000000000..6daaac320
--- /dev/null
+++ b/PIP/PIP-0043.md
@@ -0,0 +1,73 @@
+
+ PIP: PIP-0043
+ Title: Update OP_RECOVER to recover only non used, not named PASA's
+ Type: Protocol
+ Impact: Hard-Fork
+ Author: Albert Molina
+ Copyright: Albert Molina, 2023 (All Rights Reserved)
+ Comments-URI: https://discord.gg/Scr8mcwnrC (Discord channel #pip-43)
+ Status: Proposed
+ Created: 2023-03-10
+
+
+## Summary
+
+Update current OP_RECOVER operation in order to have a similar sense as described on [Original PascalCoin WhitePaper published on July 2016][1] few weeks before Genesis Block and also a community poll made on discord channel
+
+## Motivation
+
+OP_RECOVER feature was defined on original PascalCoin Whitepaper published on July 2016 as a way to allow recover coins that has lost private key.
+
+**PascalCoin WhitePaper:**
+```
+PascalCoin proposes an alternative to the basic operation of Bitcoin, through which change
+several aspects for working on the new virtual currency:
+...
+ - PascalCoin provides a method set by protocol to retrieve coins that are not used
+ instead (lost key). This method only applies if after a certain time the owner does not
+ make any operation with the account private key.
+...
+(Page 2/8)
+```
+
+Basically was a way to mantain a constant and predectible usage of inflation and available coin because burning coins are not possible.
+
+Current problem is that WhitePaper definition is ambiguous and **certain time** was not specified, initial source code proposal was to **set a time value = 4 years** (420480 blocks in PascalCoin)
+
+Another problem is that WhitePaper was mixing coins (**PASC**) and accounts (**PASA**), because what is necessary in PascalCoin is an Account (aka PASA), so we can focus on recover PASA instead of recover coins inside PASA
+
+## Proposal
+
+This PIP specifies a more accurated OP_RECOVER that was discussed on Discord Channel
+
+See poll results: https://discordapp.com/channels/383064643482025984/391780165669093377/719437469329915945
+```
+Poll on Discord
+https://discordapp.com/channels/383064643482025984/391780165669093377/719437469329915945
+RESULTS ON 2020-07-21
+1 (22 votes) - Remove PASC/PASA Recovery rule
+2 (27 votes) - Recover only EMPTY non used, not named PASA's
+3 (3 votes) - Change Recovery to 10 year rule
+4 (2 votes) - Leave As Is.
+
+Winner option 2: Will apply on next Hard Fork (Protocol 6)
+```
+
+
+## Implementation
+
+https://github.com/PascalCoin/PascalCoin/commit/290ba9c288202250f891945f629a3d2aff907e08
+
+## Affected PIP's
+
+This PIP deactivates PIP-0012 and PIP-0042
+
+## Backwards Compatibility
+
+This change is not backwards compatible and requires a hard-fork activation.
+
+## Links
+
+1. [Original PascalCoin WhitePaper published on July 2016. Accessed 2021-09.][1]
+
+[1]: https://github.com/PascalCoin/PascalCoin/blob/c22184dd7a407c6646ab651494822071726ed36e/PascalCoin%20White%20Paper%20-%20EN.pdf
diff --git a/PIP/PIP-0044.md b/PIP/PIP-0044.md
new file mode 100644
index 000000000..cc97ca9e0
--- /dev/null
+++ b/PIP/PIP-0044.md
@@ -0,0 +1,64 @@
+
+ PIP: PIP-0044
+ Title: Induplicatable NFT
+ Type: Protocol
+ Impact: Hard-Fork
+ Author: Albert Molina
+ Copyright: Albert Molina, 2023 (All Rights Reserved)
+ Comments-URI: https://discord.gg/Scr8mcwnrC (Discord channel #pip-44)
+ Status: Proposed
+ Created: 2023-03-14
+
+
+## Summary
+
+NFT (Non-fungible-token) is a well known item in the blockchain industry. It's currently based on store the item (usually a HASH of a information) in the blockchain as a Proof-of-ownership of the item.
+
+This means that this HASH of the item is stored in a transaction included in a block, and what really is used for transfers (buy/sell transactions) is a reference of the transaction, so **there is no warranty/prevention that same NFT HASH is stored in other blocks/transactions**
+
+A true NFT must be something that is impossible to be duplicated, so we present a way to store Induplicatable NFT on the blockchain because the HASH will live on the Safebox struct (that is a representation of the ledger balance of the blockchain information) and **HASH will be induplicatable** on Safebox struct, **converting NFT owner in a PASA owner**
+
+Also, thanks to Safebox current features, this Induplicatable NFT can be sold using same on-chain transactions mechanism without third party neither single point of failure (PIP-0002 - In-protocol PASA Exchange)
+
+## Proposal
+
+This PIP specifies how to use current Safebox struct and operations to store Induplicatable NFT on the PascalCoin blockchain
+
+- Safebox PASA's has Account Names and Types as described on PIP-0004, that allows to store unique Account Names in the safebox
+
+- Implementation of PIP-0004 limited Account Name to be Null or 3..64 characters long
+
+- Implementation of PIP-0004 prevents first char to be a number ('0'..'9') to not confuse name as an account number
+
+In order to use Account Name as a HASH, we must do one of proposals:
+
+- Without protocol upgrade:
+
+ - **Option A**: Use a "encode"/"decode" function to convert first char in a numeric/non-numeric char like convert "`ghijklmnop`" as "`0123456789`" for first char, so hash `9a737f6e41c58935c535fe7b08426006f246986810c21deeb808cc564b8ecdca` will be encoded to `pa737f6e41c58935c535fe7b08426006f246986810c21deeb808cc564b8ecdca` (transform 9 -> p)
+
+- With protocol upgrade (Hard fork):
+
+ - **Option B**: Start hash value with a suffix like "`nft_`" because first char cannot be an Hexadecimal numeric number, in this case the 64 characters length is a limitation because we cannot store 32 bytes hash plus suffix length in 64 chars
+
+ - **Option C**: Allows usage of numeric first char when name is a representation of a 32 bytes hexadecimal value
+
+
+This PIP-0044 will implement **Option C** allowing first char as a numberic "0".."9" char when name contains a 32 bytes (64 chars) hexadecimal value, this will prevent to use first number as an account number caused to overflow
+
+## Implementation
+
+```
+ // Update ValidAccountName function introducing this exception:
+ ...
+ if (new_name[0] in [Ord('0')..Ord('9')]) then
+ if (protocol_version>=CT_PROTOCOL_6) and
+ (length(new_name)=64) and
+ (IsHexadecimal(new_name))
+ then continue
+ else Error('Invalid numeric first char on a non-hash hexadecimal 32 bytes representation');
+ end;
+```
+
+## Backwards Compatibility
+
+This change is not backwards compatible and requires a hard-fork activation.
\ No newline at end of file
diff --git a/PIP/README.md b/PIP/README.md
index eb0ddf2ee..d484c8521 100644
--- a/PIP/README.md
+++ b/PIP/README.md
@@ -27,26 +27,29 @@ If they wish to continue, copy [this template](PIP-template.md) and ensure your
| [18](PIP-0018.md) | 10% funding allocation for Lazarus/FPC | Herman Schoenfeld | Process | Proposed |
| [19](PIP-0019.md) | Balance recovered from lost accounts to be sent to developers fund | Dr. Muhammad Amer | Protocol | Draft |
| [20](PIP-0020.md) | 6-month PascalCoin Foundation Budget Appropriations | Herman Schoenfeld | Process | Withdrawn |
-| [21](PIP-0021.md) | Agreement For Funding | Herman Schoenfeld | Process | Active |
-| [22](PIP-0022.md) | Continuous Integration | Benjamin Ansbach | Process | Draft |
-| [23](PIP-0023.md) | JSON RPC PASCURRENCY format | Benjamin Ansbach | Backend, Documentation | Draft |
-| [24](PIP-0024.md) | Account Data | Herman Schoenfeld | Protocol | Draft |
-| [26](PIP-0026.md) | URI Scheme Proposal | Ugochukwu Mmaduekwe | Front-End | Draft |
-| [27](PIP-0027.md) | E-PASA: Infinite Address-Space (via Layer-2) | Herman Schoenfeld | Protocol, Front-End | Accepted |
+| [21](PIP-0021.md) | Agreement For Funding | Herman Schoenfeld | Process | Cancelled |
+| [22](PIP-0022.md) | Continuous Integration | Benjamin Ansbach | Process | Accepted |
+| [23](PIP-0023.md) | JSON RPC PASCURRENCY format | Benjamin Ansbach | Backend, Documentation | Active |
+| [24](PIP-0024.md) | Account Data | Herman Schoenfeld | Protocol | Active |
+| [26](PIP-0026.md) | URI Scheme Proposal | Ugochukwu Mmaduekwe | Front-End | Rejected |
+| [27](PIP-0027.md) | E-PASA: Infinite Address-Space (via Layer-2) | Herman Schoenfeld | Protocol, Front-End | Proposed |
| [28](PIP-0028.md) | E-OP: Layer-2 operation encoding standard for smart-contracts | Herman Schoenfeld | Front-End | Withdrawn |
| [29](PIP-0029.md) | Account Seals: Cryptographically Secure Account Histories | Herman Schoenfeld | Protocol | Active |
| [30](PIP-0030.md) | SafeBoxRoot: Deletable SafeBox and Light-Nodes| Herman Schoenfeld | Protocol | Active |
| [31A](PIP-0031A.md) | New Wallet: Multi-Platform & Multi-Paradigm | Herman Schoenfeld | User Interface | Withdrawn |
-| [31B](PIP-0031B.md) | New GUI Wallet | mosu_forge | User Interface | Accepted |
-| [31C](PIP-0031C.md) | New Wallet: Multi-Platform | Appditto | User Interface | Accepted |
+| [31B](PIP-0031B.md) | New GUI Wallet | mosu_forge | User Interface | Cancelled |
+| [31C](PIP-0031C.md) | New Wallet: Multi-Platform | Appditto | User Interface | Active |
| [31D](https://github.com/davidbolet/PascWallet) | New Wallet: Multi-Platform & Multi-Paradigm | David Bolet | User Interface | Rejected |
-| [32A](PIP-0032A.md) | Atomic Swaps via Hash-Locked Accounts | Herman Schoenfeld | Protocol | Proposed |
+| [32A](PIP-0032A.md) | Atomic Swaps via Hash-Locked Accounts | Herman Schoenfeld | Protocol | Active |
| [33](PIP-0033.md) | DATA operation RPC implementation | Benjamin Ansbach | Backend | Proposed |
-| [34A](PIP-0034A.md) | Website UI/UX Redesigns | Appditto | Website | Proposed |
-| [35](PIP-0035.md) | Block Policy: Layer-1 Governance (Velocity Cash) | Herman Schoenfeld | Protocol | Draft |
+| [34A](PIP-0034A.md) | Website UI/UX Redesigns | Appditto | Website | Cancelled |
+| [35](PIP-0035.md) | Block Policy: Layer-1 Governance (Velocity Cash) | Herman Schoenfeld | Protocol | Proposed |
| [36](PIP-0036.md) | RandomHash2: Enhanced GPU & ASIC Resistant Hash Algorithm | Herman Schoenfeld | Protocol | Accepted |
| [37](PIP-0037.md) | Distinguish account updates between active/passive mode | Albert Molina | Protocol | Accepted |
| [38](PIP-0038.md) | P2P Chat and Communication | Preben Björn Biermann Madsen | Protocol | Draft |
-| [39](PIP-0039.md) | Temporary Voting Procedure | Gynther and the Interrim Dao-Team | Process | Draft |
-| [40](PIP-0040.md) | Pascal Governance | Gynther and the Interrim Dao-Team | Process | Draft |
+| [39](PIP-0039.md) | Temporary Voting Procedure | Gynther and the Interrim Dao-Team | Process | Cancelled |
+| [40](PIP-0040.md) | Pascal Governance | Gynther and the Interrim Dao-Team | Process | Cancelled |
+| [41](PIP-0041.md) | Pay To Key: in-protocol PASA distribution | Herman Schoenfeld | Protocol | Draft |
+| [42](PIP-0042.md) | Update OP_RECOVER to initial sense described on original WhitePaper and allow ASK FOR PASA feature | Albert Molina | Protocol | Proposed |
+| [43](PIP-0043.md) | Update OP_RECOVER to recover only non used, not named PASA's | Albert Molina | Protocol | Proposed |
diff --git a/README.md b/README.md
index 63173e065..997b2136c 100644
--- a/README.md
+++ b/README.md
@@ -1,7 +1,9 @@
-
-
-
-
+[](https://github.com/PascalCoin/PascalCoin/actions)
+
+[](https://github.com/PascalCoin/PascalCoin/releases)
+[](https://github.com/PascalCoin/PascalCoin/blob/master/LICENSE)
+[](https://discord.gg/9YYZyw)
+[](https://www.reddit.com/r/pascalcoin)
@@ -10,7 +12,7 @@
```
-Copyright (c) 2016-2020 Pascal developers based on original Albert Molina source code
+Copyright (c) 2016-2024 Pascal developers based on original Albert Molina source code
```
Please use at your own risk.
@@ -39,22 +41,24 @@ There are testnet and mainnet releases.
In case you have questions or just want to get in touch with like-minded Pascal users.
- - Listen to our twitter on: https://twitter.com/PascalCoin
+ - Our twitter feed: https://twitter.com/PascalCoin
- Chat with us on discord: https://discord.gg/9YYZyw
- - Join our subreddit on: https://discord.gg/9YYZyw
+ - Join our subreddit on: https://www.reddit.com/r/pascalcoin
## Develop with Pascal
| Language | Project Name | Type | Version support | Link |
| ------------- | ------------ | ------- | --------------- | ---- |
-| JavaScript | SBX | Library | 5 | [https://github.com/techworker/sbx](SBX) |
-| Dart | PascalDart | Library | 4 | [https://github.com/appditto/pascaldart](PascalDart) |
-| Java | JPascalCoin | Library | 4 | [https://github.com/davidbolet/JPascalCoin](JPascalCoin) |
+| JavaScript | SBX | Library | 5 | [SBX](https://github.com/techworker/sbx) |
+| Dart | PascalDart | Library | 4 | [PascalDart](https://github.com/appditto/pascaldart) |
+| Java | JPascalCoin | Library | 4 | [JPascalCoin](https://github.com/davidbolet/JPascalCoin) |
## Changelog
View the changelog [here](CHANGELOG.md)
## Donations
-
-Consider a donation using BitCoin to `16K3HCZRhFUtM8GdWRcfKeaa6KsuyxZaYk`
+
+Consider a donation using Pascal coin to development account: `0-10`
+
+Also, consider a donation using BitCoin to `16K3HCZRhFUtM8GdWRcfKeaa6KsuyxZaYk`
diff --git a/linux-libs/libcrypto.so.1.1 b/linux-libs/libcrypto.so.1.1
new file mode 100755
index 000000000..3bd113c5d
Binary files /dev/null and b/linux-libs/libcrypto.so.1.1 differ
diff --git a/release-notes.md b/release-notes.md
new file mode 100644
index 000000000..7bcc0027c
--- /dev/null
+++ b/release-notes.md
@@ -0,0 +1,2 @@
+# PascalCoin v5.7.3
+- WIP
diff --git a/src/config.inc b/src/config.inc
index 668029b34..e418a52f5 100644
--- a/src/config.inc
+++ b/src/config.inc
@@ -35,7 +35,9 @@
// Activate to define CryptoLib4Pascal by default on all compilations
{.$DEFINE Use_CryptoLib4Pascal}
-
+ // Add the following paths to the project Search Path is this option is used
+ // .\libraries\cryptolib4pascal
+ // .\libraries\simplebaselib4pascal
// Used to activate RandomHash in V4 hard-fork
{$DEFINE ACTIVATE_RANDOMHASH_V4}
@@ -64,7 +66,17 @@
// Activate ABSTRACTMEM library. Will use a virtual memory caching mechanism for efficient usage without high RAM requirements
{$DEFINE USE_ABSTRACTMEM}
+
+ // Activate GNUGETTEXT library
+ {$DEFINE USE_GNUGETTEXT}
+ // Activate usage of TPCTemporalFileStream instead of TBytes in order to minimize mem usage
+ // This also fixes issue #207 High memory usage on FreePascal compiler
+ {.$DEFINE USE_BIGBLOCKS_MEM_ON_DISK}
+
+ // This will enable to use indexed data on Blockchain storage so will allow to quick search
+ // indexed by ophash, by block/operation and account history
+ {$DEFINE USE_ABSTRACTMEM_BLOCKCHAIN_STORAGE}
{ ********************************************************************
Don't touch more code, it will addapt based on your preferences
@@ -111,6 +123,12 @@ ERROR: You must select ONLY ONE option: Use_OpenSSL or Use_CryptoLib4Pascal
{$ELSE}
{$UNDEF NO_ANSISTRING}
{$ENDIF}
+
+ {$IF COMPILERVERSION > 33}
+ {$DEFINE DELPHI_SYDNEY_PLUS}
+ {$ENDIF}
+{$ELSE}
+ {$UNDEF USE_GNUGETTEXT}
{$ENDIF}
@@ -123,3 +141,20 @@ ERROR: You must select ONLY ONE option: Use_OpenSSL or Use_CryptoLib4Pascal
{$ENDIF}
{$ENDIF}
+ {$IFDEF FPC}
+ {$IFDEF CPU32}
+ {$DEFINE IS32BITS}
+ {$UNDEF IS64BITS}
+ {$ELSE}
+ {$UNDEF IS32BITS}
+ {$DEFINE IS64BITS}
+ {$ENDIF}
+ {$ELSE}
+ {$IFDEF CPU32BITS}
+ {$DEFINE IS32BITS}
+ {$UNDEF IS64BITS}
+ {$ELSE}
+ {$UNDEF IS32BITS}
+ {$DEFINE IS64BITS}
+ {$ENDIF}
+ {$ENDIF}
diff --git a/src/core/UAbstractMemBlockchainStorage.pas b/src/core/UAbstractMemBlockchainStorage.pas
new file mode 100644
index 000000000..bbb1850ab
--- /dev/null
+++ b/src/core/UAbstractMemBlockchainStorage.pas
@@ -0,0 +1,2337 @@
+unit UAbstractMemBlockchainStorage;
+
+{ Copyright (c) 2022 by Albert Molina
+
+ Distributed under the MIT software license, see the accompanying file LICENSE
+ or visit http://www.opensource.org/licenses/mit-license.php.
+
+ This unit is a part of the PascalCoin Project, an infinitely scalable
+ cryptocurrency. Find us here:
+ Web: https://www.pascalcoin.org
+ Source: https://github.com/PascalCoin/PascalCoin
+
+ If you like it, consider a donation using Bitcoin:
+ 16K3HCZRhFUtM8GdWRcfKeaa6KsuyxZaYk
+
+ THIS LICENSE HEADER MUST NOT BE REMOVED.
+
+}
+
+{$IFDEF FPC}
+ {$mode delphi}
+{$ENDIF}
+
+interface
+
+{$I ./../config.inc}
+
+uses
+ Classes, SysUtils, UBlockchain, UThread, UCrypto, math, UAccounts, ULog,
+ SyncObjs,
+ {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF},
+ UCommon,
+ UBaseTypes, UPCDataTypes,
+ UAbstractMem, UFileMem, UCacheMem,
+ UAbstractMemBTree, UOrderedList,
+ UFileStorage,
+ UConst;
+
+type
+ EAbstractMemBlockchainStorage = Class(Exception);
+
+ TBlockchainStorageStats = record
+ blockInformationCount : Int64;
+ operationRawDataCount : Int64;
+ affectedAccountCount : Int64;
+ startTC : TTickCount;
+ procedure Clear;
+ function ToString : String;
+ function ThroughputPerSecond : Double;
+ procedure AddTo(var ADest : TBlockchainStorageStats);
+ end;
+ PBlockchainStorageStats = ^TBlockchainStorageStats;
+
+ { TAbstractMemBlockchainStorage }
+
+ TAbstractMemBlockchainStorage = Class(TStorage)
+ private
+ FFileMem : TFileMem;
+ FStorageLock : TCriticalSection;
+ FAutoFlushCache: Boolean;
+ FUseMultithread: Boolean;
+ FSaveStorageStats : TBlockchainStorageStats;
+ FPSaveStorageStats: PBlockchainStorageStats;
+ procedure SetUseMultithread(const Value: Boolean);
+ type
+ TOrphanInformation = record
+ orphan : string;
+ regsCounter : Integer;
+ procedure Clear;
+ procedure CopyFrom(const ASource : TOrphanInformation);
+ end;
+ TAMBTreeOrphanInformationByOrphan = Class(TAbstractMemBTreeData)
+ protected
+ function LoadData(const APosition : TAbstractMemPosition) : TOrphanInformation; override;
+ function SaveData(const AData : TOrphanInformation) : TAMZone; override;
+ public
+ procedure Update(const AOrphan : String; AIncrement : Integer);
+ function GetRegsCountByOrphan(const AOrphan : String) : Integer;
+ End;
+
+ TBlockInformation = record
+ operationBlock : TOperationBlock;
+ orphan : String;
+ operationsCount : Integer;
+ volume : Int64;
+ rawDataPosition : TAbstractMemPosition;
+ procedure Clear;
+ procedure SetToFindByBlock(ABlock : Integer);
+ function ToSerialized : TBytes;
+ function FromSerialized(ABytes : TBytes) : Boolean;
+ function GetRawData(AAbstractMem : TAbstractMem; var ARawData : TBytes) : Boolean;
+ function CreateTPCOperationsComp(AAbstractMem : TAbstractMem; ABank: TPCBank) : TPCOperationsComp;
+ procedure ReadTPCOperationsComp(AAbstractMem : TAbstractMem; AOperationsComp : TPCOperationsComp);
+ function IsOrphan(const AOrphan : String) : Boolean;
+ procedure CopyFrom(const ASource : TBlockInformation);
+ end;
+ TAMBTreeOperationBlockInformationByOrphanBlock = Class(TAbstractMemBTreeData)
+ protected
+ function LoadData(const APosition : TAbstractMemPosition) : TBlockInformation; override;
+ function SaveData(const AData : TBlockInformation) : TAMZone; override;
+ procedure DeletedData(const AData: TBlockInformation); override;
+ public
+ function GetBlockInformationByBlock(ABlock : Integer) : TBlockInformation;
+ End;
+
+ TOperationRawData = record
+ rightOpHash : TBytes;
+ account : Integer;
+ n_operation : Integer;
+ block : Integer;
+ opblock : Integer;
+ opType : Integer;
+ opSavedProtocol : Integer;
+ rawData : TBytes;
+ procedure Clear;
+ procedure SetToFindByRightOpHash(const ARightOpHash : TBytes);
+ procedure SetToFindByBlockOpblock(ABlock, AOpblock : Integer);
+ function ToSerialized : TBytes;
+ function FromSerialized(ABytes : TBytes) : Boolean;
+ procedure CopyFrom(const ASource : TOperationRawData);
+ function CreateTPCOperation(AAbstractMem : TAbstractMem) : TPCOperation; overload;
+ function CreateTPCOperation(AAbstractMem : TAbstractMem; out APCOperation : TPCOperation) : Boolean; overload;
+ end;
+ TAMBTreeTOperationRawDataByRightOpHash = Class(TAbstractMemBTreeData)
+ protected
+ function LoadData(const APosition : TAbstractMemPosition) : TOperationRawData; override;
+ function SaveData(const AData : TOperationRawData) : TAMZone; override;
+ End;
+ TAMBTreeTOperationRawDataByBlockOpBlock_Index = Class(TAbstractMemBTreeDataIndex)
+ End;
+
+ TAffectedAccount = record
+ account : Integer;
+ n_operation : Integer;
+ block : Integer;
+ opblock : Integer;
+ procedure Clear;
+ procedure SetToFindByAccount(AAccount : Integer);
+ procedure SetToFindByAccountBlockOpblock(AAccount, ABlock, AOpblock : Integer);
+ function ToSerialized : TBytes;
+ function FromSerialized(ABytes : TBytes) : Boolean;
+ procedure CopyFrom(const ASource : TAffectedAccount);
+ function ToString:String;
+ end;
+ TAMBTreeTAffectedAccountByAccountBlockOpBlock = Class(TAbstractMemBTreeData)
+ protected
+ function LoadData(const APosition : TAbstractMemPosition) : TAffectedAccount; override;
+ function SaveData(const AData : TAffectedAccount) : TAMZone; override;
+ End;
+
+ TPendingData = record
+ operation : TOperationRawData;
+ affectedAccounts : Array of TAffectedAccount;
+ procedure Clear;
+ end;
+
+ TPendingToSaveThread = Class;
+
+ TPendingToSave = Class
+ private
+ FAMStorage : TAbstractMemBlockchainStorage;
+ FMaxThreads : Integer;
+ FPending : TThreadList;
+ FThreads : TThreadList;
+ FOperationsRawData_By_RightOpHash : TAMBTreeTOperationRawDataByRightOpHash;
+ FAffectedAccounts_By_Account_Block_OpBlock : TAMBTreeTAffectedAccountByAccountBlockOpBlock;
+ FTotal: Integer;
+ FMaxPendingsCount: Integer;
+ FLastLogTC : TTickCount;
+ procedure SetMaxThreads(const Value: Integer);
+ protected
+ procedure ThreadHasFinishedCurrentJob;
+ public
+ procedure AddPendingData(const APendingData : TPendingData);
+ constructor Create(AStorage : TAbstractMemBlockchainStorage; AAMBTreeTOperationRawDataByRightOpHash : TAMBTreeTOperationRawDataByRightOpHash;
+ AAMBTreeTAffectedAccountByAccountBlockOpBlock : TAMBTreeTAffectedAccountByAccountBlockOpBlock);
+ destructor Destroy; override;
+ property MaxThreads : Integer read FMaxThreads write SetMaxThreads;
+ function PendingsCount : Integer;
+ property Total : Integer read FTotal write FTotal;
+ property MaxPendingsCount : Integer read FMaxPendingsCount write FMaxPendingsCount;
+ End;
+
+ TPendingToSaveThread = Class(TPCThread)
+ private
+ FPendingToSave : TPendingToSave;
+ FBusy: Boolean;
+ protected
+ procedure BCExecute; override;
+ public
+ Constructor Create(APendingToSave : TPendingToSave);
+ property Busy : Boolean read FBusy write FBusy;
+ End;
+
+ var
+ FOrphansInformation_By_Orphan : TAMBTreeOrphanInformationByOrphan;
+ FBlocksInformation_By_OrphanBlock : TAMBTreeOperationBlockInformationByOrphanBlock;
+ FOperationsRawData_By_RightOpHash : TAMBTreeTOperationRawDataByRightOpHash;
+ FOperationsRawData_By_Block_OpBlock_Index : TAMBTreeTOperationRawDataByBlockOpBlock_Index;
+ FAffectedAccounts_By_Account_Block_OpBlock : TAMBTreeTAffectedAccountByAccountBlockOpBlock;
+
+ FPendingToSave : TPendingToSave;
+ FCheckingConsistency : Boolean;
+ FCheckingConsistencyProgress : String;
+ FCheckingConsistencyStats : TBlockchainStorageStats;
+ FLogSaveActivity : Boolean;
+ FInBlockNotFound : Boolean;
+ FInBlockSaving : Integer;
+
+ function GetFirstBlockNumberByOrphan(const AOrphan : String): Int64;
+ function GetLastBlockNumberByOrphan(const AOrphan : String): Int64;
+ Function DoBlockExistsByOrphan(ABlock : Integer; const AOrphan : String; var LBlockInformation : TBlockInformation) : Boolean;
+
+ function DeleteBlockChainBlockExt(ABlock : Integer; const AOrphan : String) : Boolean;
+ Function DoSaveBlockChainExt(Operations : TPCOperationsComp; const AOrphan : String; var AStats : TBlockchainStorageStats) : Boolean;
+ Function DoLoadBlockChainExt(Operations : TPCOperationsComp; Block : Cardinal; const AOrphan : String) : Boolean;
+ procedure AddMessage(AMessages : TStrings; const AMessage : String; ARaiseAnException : Boolean);
+ procedure OnCacheMemFlushedCache(const ASender : TCacheMem; const AProcessDesc : String; AElapsedMilis: Int64);
+ procedure OnCacheMemLog(ASender : TObject; const ALog : String);
+ protected
+ procedure SetReadOnly(const Value: Boolean); override;
+ Function DoGetBlockInformation(const ABlock : Integer; var AOperationBlock : TOperationBlock; var AOperationsCount : Integer; var AVolume : Int64) : Boolean; override;
+
+ Function DoLoadBlockChain(Operations : TPCOperationsComp; Block : Cardinal) : Boolean; override;
+ Function DoSaveBlockChain(Operations : TPCOperationsComp) : Boolean; override;
+ Function DoMoveBlockChain(StartBlock : Cardinal; Const DestOrphan : TOrphan) : Boolean; override;
+ Procedure DoDeleteBlockChainBlocks(StartingDeleteBlock : Cardinal); override;
+ Function DoBlockExists(Block : Cardinal) : Boolean; override;
+ function GetFirstBlockNumber: Int64; override;
+ function GetLastBlockNumber: Int64; override;
+ function DoInitialize : Boolean; override;
+ Procedure DoEraseStorage; override;
+ function CheckBlockConsistency(ARaiseOnError : Boolean; AMessages : TStrings; const ABlockInformation : TBlockInformation; out AOperationsCount, AAffectedAccountsCount : Integer; AThread : TPCThread) : Boolean;
+
+ procedure DoBlockNotFound(ABlock : Integer; var AFound : Boolean); virtual;
+ procedure BlockNotFound(ABlock : Integer; var AFound : Boolean);
+
+ Function DoGetBlockOperations(ABlock, AOpBlockStartIndex, AMaxOperations : Integer; var AOperationBlock : TOperationBlock; var AOperationsCount : Integer; var AVolume : Int64; const AOperationsResumeList:TOperationsResumeList) : Boolean; override;
+ Function DoGetAccountOperations(AAccount : Integer; AMaxDepth, AStartOperation, AMaxOperations, ASearchBackwardsStartingAtBlock: Integer; const AOperationsResumeList:TOperationsResumeList): Boolean; override;
+ function DoFindOperation(const AOpHash : TBytes; var AOperationResume : TOperationResume) : TSearchOpHashResult; override;
+ Function DoGetOperation(const ABlock, AOpBlock : Integer; const AOperations : TOperationsHashTree) : Boolean;
+ public
+ Constructor Create(AOwner : TComponent); Override;
+ Destructor Destroy; Override;
+ procedure FinalizedUpdating;
+ procedure CheckConsistency(ARaiseOnError: Boolean; AMessages: TStrings; AThread : TPCThread); overload;
+ function CheckConsistency(const AOrphan : String; AFromBlock , AToBlock : Integer; ARaiseOnError : Boolean; AMessages : TStrings; out ABlocksFound, AOperationsFound, AAffectedAccountsFound : Integer; AThread : TPCThread) : Boolean; overload;
+ property FileMem : TFileMem read FFileMem;
+ property AutoFlushCache : Boolean read FAutoFlushCache write FAutoFlushCache;
+
+ Procedure FillInfo(AStrings : TStrings);
+ class function OrphanCompare(const ALeft, ARight : String) : Integer; inline;
+ function PendingToSave : Integer;
+ procedure AbortPendingToSave;
+ property UseMultithread : Boolean read FUseMultithread write SetUseMultithread;
+
+ property CheckingConsistency : Boolean read FCheckingConsistency;
+ property CheckingConsistencyProgress : String read FCheckingConsistencyProgress;
+ property CheckingConsistencyStats : TBlockchainStorageStats read FCheckingConsistencyStats;
+ property SaveStorageStats : PBlockchainStorageStats read FPSaveStorageStats;
+ property LogSaveActivity : Boolean read FLogSaveActivity write FLogSaveActivity;
+ End;
+
+
+ TAbstractMemBlockchainStorageSecondary = Class(TAbstractMemBlockchainStorage)
+ private
+ FAuxStorage : TStorage;
+ FSaving : Boolean;
+ protected
+ procedure SetReadOnly(const Value: Boolean); override;
+ Function DoSaveBlockChain(Operations : TPCOperationsComp) : Boolean; override;
+ Function DoMoveBlockChain(StartBlock : Cardinal; Const DestOrphan : TOrphan) : Boolean; override;
+ Procedure DoDeleteBlockChainBlocks(StartingDeleteBlock : Cardinal); override;
+ function DoInitialize : Boolean; override;
+ procedure DoBlockNotFound(ABlock : Integer; var AFound : Boolean); override;
+ public
+ Constructor Create(AOwner : TComponent); Override;
+ Destructor Destroy; Override;
+ property AuxStorage : TStorage read FAuxStorage;
+ End;
+
+
+implementation
+
+
+function Comparer_TOrphanInformation_By_Orphan(const ALeft, ARight : TAbstractMemBlockchainStorage.TOrphanInformation) : Integer;
+begin
+ Result := TAbstractMemBlockchainStorage.OrphanCompare(ALeft.orphan,ARight.orphan);
+end;
+
+function Comparer_TBlockInformation_By_OrphanBlock(const ALeft, ARight : TAbstractMemBlockchainStorage.TBlockInformation) : Integer;
+begin
+ Result := TAbstractMemBlockchainStorage.OrphanCompare(ALeft.orphan,ARight.orphan);
+ if Result=0 then begin
+ if ALeft.operationBlock.blockARight.operationBlock.block then Result := 1
+ else Result := 0;
+ end;
+end;
+
+function Comparer_TOperationRawData_By_RightOpHash(const ALeft, ARight : TAbstractMemBlockchainStorage.TOperationRawData) : Integer;
+begin
+ Result := BytesCompare(ALeft.rightOpHash,ARight.rightOpHash);
+end;
+
+function Comparer_TOperationRawData_By_Block_OpBlock(const ALeft, ARight : TAbstractMemBlockchainStorage.TOperationRawData) : Integer;
+begin
+ Result := ALeft.block - ARight.block;
+ if Result=0 then Result := ALeft.opblock - ARight.opblock;
+end;
+
+function Comparer_TAffectedAccount_By_Account_Block_OpBlock(const ALeft, ARight : TAbstractMemBlockchainStorage.TAffectedAccount) : Integer;
+begin
+ Result := ALeft.account - ARight.account;
+ if Result=0 then Result := ALeft.block - ARight.block;
+ if Result=0 then Result := ALeft.opblock - ARight.opblock;
+end;
+
+
+{ TAbstractMemBlockchainStorage }
+
+procedure TAbstractMemBlockchainStorage.AbortPendingToSave;
+begin
+ FreeAndNil(FPendingToSave);
+end;
+
+procedure TAbstractMemBlockchainStorage.AddMessage(AMessages: TStrings; const AMessage: String; ARaiseAnException : Boolean);
+begin
+ if Assigned(AMessages) then AMessages.Add(AMessage);
+ if ARaiseAnException then raise EAbstractMemBlockchainStorage.Create(AMessage);
+ TLog.NewLog(ltinfo,ClassName,AMessage);
+ FCheckingConsistencyProgress := AMessage;
+end;
+
+procedure TAbstractMemBlockchainStorage.BlockNotFound(ABlock: Integer; var AFound : Boolean);
+begin
+ AFound := False;
+ if FInBlockNotFound then begin
+ TLog.NewLog(ltdebug,ClassName,Format('BlockNotFound cannot save Block:%d because saving block:%d',[ABlock,FInBlockSaving]));
+ Exit;
+ end;
+ FInBlockNotFound := True;
+ try
+ FInBlockSaving := ABlock;
+ DoBlockNotFound(ABlock,AFound);
+ finally
+ FInBlockNotFound := False;
+ end;
+end;
+
+function TAbstractMemBlockchainStorage.CheckBlockConsistency(
+ ARaiseOnError: Boolean; AMessages: TStrings; const ABlockInformation : TBlockInformation; out AOperationsCount, AAffectedAccountsCount : Integer;
+ AThread : TPCThread): Boolean;
+var LErrorsCount : Integer;
+ procedure AddInfo(AIsError : Boolean; const AMessage : String);
+ Var LTxt : String;
+ begin
+ if AIsError then begin
+ Result := False;
+ inc(LErrorsCount);
+ LTxt := 'ERROR: '+AMessage;
+ end else LTxt := AMessage;
+ AddMessage(AMessages,LTxt,(AIsError and ARaiseOnError));
+ end;
+var
+ LOperationsCounter : Integer;
+ LOperationRawDataToSearch, LOperationRawData,
+ LOperationRawDataAux, LOperationRawDataAuxFound : TOperationRawData;
+ LOperationsComp : TPCOperationsComp;
+ LOperation : TPCOperation;
+ LRawData : TBytes;
+ LError : String;
+ LPos : TAbstractMemPosition;
+ LAffectedAccountsList : TOrderedList;
+ LAffectedAccount, LAffectedAccountFound : TAffectedAccount;
+ i : Integer;
+begin
+ Result := True;
+ LErrorsCount := 0;
+ AAffectedAccountsCount := 0;
+ AOperationsCount := 0;
+ if Not ABlockInformation.GetRawData(FFileMem,LRawData) then begin
+ AddInfo(True,Format('Cannot obtain raw data from block %d at pos %d',[AblockInformation.operationBlock.block,ABlockInformation.rawDataPosition]));
+ end;
+ LOperationsComp := ABlockInformation.CreateTPCOperationsComp(FFileMem,Nil);
+ Try
+ //
+ if LOperationsComp.Count<>ABlockInformation.operationsCount then begin
+ AddInfo(True,Format('Block %d operations count not equal %d <> %d',[AblockInformation.operationBlock.block,AblockInformation.operationsCount,LOperationsComp.Count]));
+ end;
+ if LOperationsComp.OperationsHashTree.TotalAmount<>ABlockInformation.volume then begin
+ AddInfo(True,Format('Block %d volume not equal %d <> %d',[AblockInformation.operationBlock.block,AblockInformation.volume,LOperationsComp.OperationsHashTree.TotalAmount]));
+ end;
+ //
+ LOperationsCounter := 0;
+ LOperationRawDataToSearch.Clear;
+ LOperationRawDataToSearch.block := ABlockInformation.operationBlock.block;
+ LOperationRawDataToSearch.opblock := 0;
+ if FOperationsRawData_By_Block_OpBlock_Index.FindData(LOperationRawDataToSearch,LPos,LOperationRawData) then begin
+ repeat
+ if Assigned(AThread) and AThread.Terminated then Break;
+
+ Inc(FCheckingConsistencyStats.operationRawDataCount);
+ FCheckingConsistencyProgress := Format('Orphan "%s" Block %d Operation %d/%d',[ABlockInformation.orphan,ABlockInformation.operationBlock.block,LOperationRawData.opblock+1,ABlockInformation.operationsCount]);
+
+ LOperationRawDataAux.CopyFrom(LOperationRawData);
+ if not FOperationsRawData_By_RightOpHash.FindData(LOperationRawDataAux,LPos,LOperationRawDataAuxFound) then begin
+ AddInfo(True,Format('Block %d operation %d not found by searching by OpHash',[LOperationRawData.block,LOperationRawData.opblock]));
+ end;
+ //
+ LOperation := LOperationRawData.CreateTPCOperation(FFileMem);
+ Try
+ if (Not BytesEqual(LOperationRawData.rightOpHash,LOperation.RipeMD160)) then raise EAbstractMemBlockchainStorage.Create('ERR 20211116-1');
+ if LOperationRawData.account<>LOperation.SignerAccount then raise EAbstractMemBlockchainStorage.Create('ERR 20211116-2');
+ if LOperationRawData.n_operation<>LOperation.N_Operation then raise EAbstractMemBlockchainStorage.Create('ERR 20211116-3');
+ //
+ if (Not BytesEqual(LOperation.RipeMD160,LOperationsComp.Operation[LOperationRawData.opblock].RipeMD160)) then raise EAbstractMemBlockchainStorage.Create('ERR 20211116-4');
+ // Check affected accounts:
+ LAffectedAccountsList := TOrderedList.Create(False,TComparison_Cardinal);
+ Try
+ LOperation.AffectedAccounts(LAffectedAccountsList);
+ for i := 0 to LAffectedAccountsList.Count-1 do begin
+ LAffectedAccount.Clear;
+ LAffectedAccount.account := LAffectedAccountsList.Get(i);
+ LAffectedAccount.n_operation := LOperation.GetAccountN_Operation(LAffectedAccount.account);
+ LAffectedAccount.block := ABlockInformation.operationBlock.block;
+ LAffectedAccount.opblock := LOperationRawData.opblock;
+
+ Inc(FCheckingConsistencyStats.affectedAccountCount);
+ FCheckingConsistencyProgress := Format('Orphan "%s" Block %d Operation %d/%d Account %d/%d',
+ [ABlockInformation.orphan,ABlockInformation.operationBlock.block,LOperationRawData.opblock+1,ABlockInformation.operationsCount,
+ i+1,LAffectedAccountsList.Count]);
+
+ if Not FAffectedAccounts_By_Account_Block_OpBlock.FindData(LAffectedAccount,LPos,LAffectedAccountFound) then begin
+ AddInfo(True,Format('Affected account %d (%d/%d) for block %d opblock %d/%d not found',[LAffectedAccount.account,
+ i+1,LAffectedAccountsList.Count, LAffectedAccount.block, LAffectedAccount.opblock+1, ABlockInformation.operationsCount]));
+ end else begin
+ if LAffectedAccountFound.n_operation <> LOperation.GetAccountN_Operation(LAffectedAccount.account) then begin
+ AddInfo(True,Format('Invalid n_operation %d for account %d (%d/%d) for block %d opblock %d/%d',[LAffectedAccountFound.n_operation, LAffectedAccount.account,
+ i+1,LAffectedAccountsList.Count, LAffectedAccount.block, LAffectedAccount.opblock+1, ABlockInformation.operationsCount]));
+ end;
+ end;
+ end;
+ inc(AAffectedAccountsCount, LAffectedAccountsList.Count);
+ Finally
+ LAffectedAccountsList.Free;
+ End;
+ Finally
+ LOperation.Free;
+ End;
+ //
+ inc(LOperationsCounter);
+ Inc(LOperationRawDataToSearch.opblock);
+ until Not (FOperationsRawData_By_Block_OpBlock_Index.FindData(LOperationRawDataToSearch,LPos,LOperationRawData));
+ end;
+ if LOperationsCounter<>ABlockInformation.operationsCount then begin
+ AddInfo(True,Format('Block %d has %d operations but %d was found',[ABlockInformation.operationBlock.block,ABlockInformation.operationsCount,LOperationsCounter]));
+ end;
+ AOperationsCount := LOperationsCounter;
+ Finally
+ LOperationsComp.Free;
+ End;
+end;
+
+procedure TAbstractMemBlockchainStorage.CheckConsistency(ARaiseOnError: Boolean; AMessages: TStrings; AThread : TPCThread);
+var LOrphans, LSearch : TOrphanInformation;
+ LOrphansCount, LBlocksFound, LOperationsFound, LAffectedAccountsFound,
+ Ltemp1, Ltemp2, Ltemp3 : Integer;
+ LMyOrphanFound : Boolean;
+begin
+ if FCheckingConsistency then begin
+ if ARaiseOnError then raise EAbstractMemBlockchainStorage.Create('Checking consistency in process...');
+ Exit;
+ end;
+ LMyOrphanFound := False;
+ LBlocksFound := 0;
+ LOperationsFound := 0;
+ LAffectedAccountsFound := 0;
+ LOrphansCount := 0;
+ LOrphans.Clear;
+ AddMessage(AMessages,Format('Start CheckConsistency process for My Orphan "%s"',[Orphan]),False);
+ if FOrphansInformation_By_Orphan.FindDataLowest(LOrphans) then begin
+ repeat
+ if Assigned(AThread) and (AThread.Terminated) then Break;
+ inc(LOrphansCount);
+ AddMessage(AMessages,Format('Start analyzing orphan "%s" with %d registers',[LOrphans.orphan,LOrphans.regsCounter]),False);
+ if not CheckConsistency(LOrphans.orphan,-1,-1,ARaiseOnError,AMessages,Ltemp1,Ltemp2,Ltemp3,AThread) then begin
+ AddMessage(AMessages,Format('Errors analyzing orphan "%s"',[LOrphans.orphan]),ARaiseOnError);
+ end;
+ inc(LBlocksFound,Ltemp1);
+ inc(LOperationsFound,Ltemp2);
+ inc(LAffectedAccountsFound,Ltemp3);
+ LMyOrphanFound := LMyOrphanFound or (OrphanCompare(LOrphans.orphan,Orphan)=0);
+ LSearch := LOrphans;
+ until Not (FOrphansInformation_By_Orphan.FindDataSuccessor(LSearch,LOrphans));
+ end;
+ if not LMyOrphanFound then begin
+ AddMessage(AMessages,Format('Warning: My orphan "%s" not found in list!',[Self.Orphan]),False);
+ //
+ if Not CheckConsistency(Self.Orphan,-1,-1,ARaiseOnError,AMessages,Ltemp1,Ltemp2,Ltemp3,AThread) then begin
+ AddMessage(AMessages,Format('Errors analyzing My orphan "%s"',[Self.Orphan]),ARaiseOnError);
+ end;
+ inc(LBlocksFound,Ltemp1);
+ inc(LOperationsFound,Ltemp2);
+ inc(LAffectedAccountsFound,Ltemp3);
+ end;
+ if (LBlocksFound<>FBlocksInformation_By_OrphanBlock.Count) then begin
+ AddMessage(AMessages,Format('Error: Found %d blocks but expected %d',[LBlocksFound,FBlocksInformation_By_OrphanBlock.Count]),ARaiseOnError);
+ end;
+ if (LOperationsFound<>FOperationsRawData_By_RightOpHash.Count) then begin
+ AddMessage(AMessages,Format('Error: Found %d operations but expected %d',[LOperationsFound,FOperationsRawData_By_RightOpHash.Count]),ARaiseOnError);
+ end;
+ if (LAffectedAccountsFound<>FAffectedAccounts_By_Account_Block_OpBlock.Count) then begin
+ AddMessage(AMessages,Format('Error: Found %d accounts but expected %d',[LAffectedAccountsFound,FAffectedAccounts_By_Account_Block_OpBlock.Count]),ARaiseOnError);
+ end;
+ if (FOperationsRawData_By_RightOpHash.Count<>FOperationsRawData_By_Block_OpBlock_Index.Count) then begin
+ AddMessage(AMessages,Format('Error: Indexes for operations %d not %d',[FOperationsRawData_By_RightOpHash.Count,FOperationsRawData_By_Block_OpBlock_Index.Count]),ARaiseOnError);
+ end;
+
+
+ AddMessage(AMessages,Format('Finalized analyzing orphans with %d orphans %d blocks %d operations and %d accounts',
+ [LOrphansCount,LBlocksFound,LOperationsFound,LAffectedAccountsFound]),False);
+end;
+
+function TAbstractMemBlockchainStorage.CheckConsistency(const AOrphan: String;
+ AFromBlock, AToBlock: Integer;
+ ARaiseOnError: Boolean; AMessages: TStrings;
+ out ABlocksFound, AOperationsFound, AAffectedAccountsFound : Integer; AThread : TPCThread): Boolean;
+var LMessages : TStringList;
+ LErrorsCount : Integer;
+ procedure AddInfo(AIsError : Boolean; const AMessage : String);
+ Var LTxt : String;
+ begin
+ if AIsError then begin
+ Result := False;
+ inc(LErrorsCount);
+ LTxt := 'ERROR: '+AMessage;
+ if ARaiseOnError then raise Exception.Create(Self.ClassName+' not consistent: '+LTxt);
+ end else LTxt := 'INFO: '+AMessage;
+ AddMessage(AMessages,Ltxt,AIsError and ARaiseOnError);
+ end;
+var LBlockInformation, LPreviousBlockInformation : TBlockInformation;
+ LBlocksInformationMin,LBlocksInformationMax : Integer;
+ LOperationRawData,LOperationRawDataAux,LOperationRawDataAuxFound : TOperationRawData;
+ LAffectedAccount : TAffectedAccount;
+ LPos : TAbstractMemPosition;
+
+ LTempOperationsCounter, LTempAccountsCounter : Integer;
+ LContinue : Boolean;
+ LOrphanInformation,LOrphanInformationFound : TOrphanInformation;
+ LTC,LStartTC : TTickCount;
+begin
+ Assert((AToBlock<0) or (AToBlock>=AFromBlock),Format('Invalid from %d to %d values',[AFromBlock,AToBlock]));
+ Result := True;
+
+ LBlocksInformationMin := 0;
+ LBlocksInformationMax := 0;
+
+ ABlocksFound := 0;
+ AOperationsFound := 0;
+ AAffectedAccountsFound := 0;
+
+ if FCheckingConsistency then begin
+ if ARaiseOnError then raise EAbstractMemBlockchainStorage.Create('Checking consistency in process...');
+ Exit;
+ end;
+ FCheckingConsistencyStats.Clear;
+ FCheckingConsistency := True;
+ Try
+
+ LPreviousBlockInformation.Clear;
+ if (AFromBlock<0) then begin
+ AFromBlock := GetFirstBlockNumberByOrphan(AOrphan);
+ end;
+ LTC := TPlatform.GetTickCount;
+ LStartTC := LTC;
+ LContinue := ((AToBlock<0) or (AFromBlock<=AToBlock)) and (DoBlockExistsByOrphan(AFromBlock,AOrphan,LBlockInformation));
+ if (LContinue) then begin
+ inc(ABlocksFound);
+ LPreviousBlockInformation.CopyFrom(LBlockInformation);
+ // Initialize
+ LBlocksInformationMin := LBlockInformation.operationBlock.block;
+ LBlocksInformationMax := LBlockInformation.operationBlock.block;
+ // Check operations count
+ if (OrphanCompare(AOrphan,Self.Orphan)=0) then begin
+ CheckBlockConsistency(ARaiseOnError,AMessages,LBlockInformation,LTempOperationsCounter,LTempAccountsCounter,AThread);
+ inc(AOperationsFound,LTempOperationsCounter);
+ inc(AAffectedAccountsFound,LTempAccountsCounter);
+ end;
+ //
+ while (FBlocksInformation_By_OrphanBlock.FindDataSuccessor(LPreviousBlockInformation,LBlockInformation)) do begin
+ Inc(FCheckingConsistencyStats.blockInformationCount);
+ FCheckingConsistencyProgress := Format('Orphan "%s" Block %d Operations %d',[LBlockInformation.orphan,LBlockInformation.operationBlock.block,LBlockInformation.operationsCount]);
+ if Assigned(AThread) and (AThread.Terminated) then Break;
+
+ if ((AToBlock>=0) and (AToBlock= LBlockInformation.operationBlock.block) then begin
+ AddInfo(True,Format('Previous block %d >= current block %d (DUPLICATE OR INVALID ORDER!)',[LPreviousBlockInformation.operationBlock.block,LBlockInformation.operationBlock.block]));
+ end else if LPreviousBlockInformation.operationBlock.block+1 <> LBlockInformation.operationBlock.block then begin
+ AddInfo(False,Format('Previous block %d+1 Not current block %d',[LPreviousBlockInformation.operationBlock.block,LBlockInformation.operationBlock.block]));
+ end;
+
+ if LBlocksInformationMax < LBlockInformation.operationBlock.block then LBlocksInformationMax := LBlockInformation.operationBlock.block;
+ //
+ // Check operations count
+ if (OrphanCompare(AOrphan,Self.Orphan)=0) then begin
+ CheckBlockConsistency(ARaiseOnError,AMessages,LBlockInformation,LTempOperationsCounter,LTempAccountsCounter,AThread);
+ inc(AOperationsFound,LTempOperationsCounter);
+ inc(AAffectedAccountsFound,LTempAccountsCounter);
+ end;
+ //
+ inc(ABlocksFound);
+ LPreviousBlockInformation.CopyFrom(LBlockInformation);
+ if (TPlatform.GetElapsedMilliseconds(LTC)>6000) then begin
+ TLog.NewLog(ltdebug,ClassName,Format('Consistency checking %d/%d elapsed %s seconds',[LBlockInformation.operationBlock.block,AToBlock,FormatFloat('0.00',TPlatform.GetElapsedMilliseconds(LStartTC)/1000)]));
+ LTC := TPlatform.GetTickCount;
+ end;
+ end;
+ end;
+ if (AToBlock<0) and (GetLastBlockNumberByOrphan(AOrphan)>0) and (GetLastBlockNumberByOrphan(AOrphan)<>LBlocksInformationMax) then begin
+ AddInfo(True,Format('Last block found %d not what expected %d',[LBlocksInformationMax,GetLastBlockNumberByOrphan(AOrphan)]));
+ end;
+
+ if (OrphanCompare(AOrphan,Self.Orphan)=0) then begin
+ if (FOperationsRawData_By_RightOpHash.Count<>AOperationsFound) then begin
+ AddInfo(False,Format('Stored %d operations but only %d on processed blocks',[FOperationsRawData_By_RightOpHash.Count,AOperationsFound]));
+ end;
+ if FAffectedAccounts_By_Account_Block_OpBlock.Count<>AAffectedAccountsFound then begin
+ AddInfo(False,Format('Stored %d affected accounts but only %d on processed blocks',[FAffectedAccounts_By_Account_Block_OpBlock.Count,AAffectedAccountsFound]));
+ end;
+ end;
+ LOrphanInformation.Clear;
+ LOrphanInformation.orphan := AOrphan;
+ if FOrphansInformation_By_Orphan.FindData(LOrphanInformation,LPos,LOrphanInformationFound) then begin
+ if LOrphanInformationFound.regsCounter<>ABlocksFound then begin
+ AddInfo((AToBlock<0),Format('Orphan information counter expected %d found %d for orphan "%s"',[LOrphanInformationFound.regsCounter,ABlocksFound,AOrphan]));
+ end;
+ end else begin
+ AddInfo(True,Format('Not found information for Orphan "%s"',[AOrphan]));
+ end;
+
+ AddInfo(False,Format('Analyzed from block %d to %d on orphan "%s" (expected %d/%d pending %d) Operations %d Accounts %d',[
+ LBlocksInformationMin,LBlocksInformationMax,
+ AOrphan,
+ ABlocksFound, (LBlocksInformationMax - LBlocksInformationMin + 1), (LBlocksInformationMax - LBlocksInformationMin + 1)- ABlocksFound,
+
+ AOperationsFound,AAffectedAccountsFound]));
+
+ Finally
+ FCheckingConsistency := False;
+ FCheckingConsistencyProgress := '';
+ End;
+end;
+
+constructor TAbstractMemBlockchainStorage.Create(AOwner: TComponent);
+begin
+ inherited;
+ FInBlockNotFound := False;
+ FInBlockSaving := 0;
+ FLogSaveActivity := True;
+ FSaveStorageStats.Clear;
+ FPSaveStorageStats := @FSaveStorageStats;
+ FPSaveStorageStats^.clear;
+ FCheckingConsistency := False;
+ FCheckingConsistencyProgress := '';
+ FCheckingConsistencyStats.Clear;
+ FUseMultithread := True;
+ FFileMem := Nil;
+ FOrphansInformation_By_Orphan := Nil;
+ FBlocksInformation_By_OrphanBlock := Nil;
+ FOperationsRawData_By_RightOpHash := Nil;
+ FOperationsRawData_By_Block_OpBlock_Index := Nil;
+ FAffectedAccounts_By_Account_Block_OpBlock := Nil;
+ FAutoFlushCache := True;
+ FStorageLock := TCriticalSection.Create;
+ FPendingToSave := Nil;
+end;
+
+function TAbstractMemBlockchainStorage.DeleteBlockChainBlockExt(ABlock : Integer; const AOrphan : String) : Boolean;
+var LBlock : TBlockInformation;
+ LOperationRawDataSearch,LOperationRawDataFound : TOperationRawData;
+ LPos : TAbstractMemPosition;
+ LOperation : TPCOperation;
+ LAffectedAccountSearch, LAffectedAccountFound, LAffectedAccount : TAffectedAccount;
+ LAffectedAccounts : TOrderedList;
+ i : Integer;
+begin
+ Result := False;
+ LBlock.Clear;
+ LBlock.orphan := AOrphan;
+ LBlock.operationBlock.block := ABlock;
+ if Not (FBlocksInformation_By_OrphanBlock.DeleteData(LBlock)) then Exit;
+
+ FOrphansInformation_By_Orphan.Update(AOrphan,-1);
+
+ Result := True;
+
+ if OrphanCompare(AOrphan,Orphan)<>0 then Exit;
+
+ // Try to delete all operations and affected accounts:
+ LOperationRawDataSearch.Clear;
+ LOperationRawDataSearch.block := LBlock.operationBlock.block;
+ LOperationRawDataSearch.opblock := MAXINT; // Will search BACKWARDS
+ FOperationsRawData_By_Block_OpBlock_Index.FindData(LOperationRawDataSearch,LOperationRawDataFound);
+ while (LOperationRawDataSearch.opblock>=0) and (LOperationRawDataFound.block = LOperationRawDataSearch.block) do begin
+ // Delete affected accounts
+
+ if LOperationRawDataFound.CreateTPCOperation(FFileMem,LOperation) then
+ try
+ LAffectedAccounts := TOrderedList.Create(False,TComparison_Cardinal);
+ Try
+ LOperation.AffectedAccounts(LAffectedAccounts);
+ for i := 0 to LAffectedAccounts.Count-1 do begin
+ LAffectedAccount.Clear;
+ LAffectedAccount.account := LAffectedAccounts.Items[i];
+ LAffectedAccount.block := ABlock;
+ LAffectedAccount.opblock := LOperationRawDataFound.opblock;
+ //
+ if Not FAffectedAccounts_By_Account_Block_OpBlock.DeleteData(LAffectedAccount) then begin
+ TLog.NewLog(lterror,ClassName,Format('ERR 20211117-01 Affected account %d %d %d not found',[LAffectedAccount.account,LAffectedAccount.block,LAffectedAccount.opblock+1]));
+ end;
+
+ end;
+ Finally
+ LAffectedAccounts.Free;
+ end;
+ Finally
+ LOperation.Free;
+ end;
+ if not FOperationsRawData_By_RightOpHash.DeleteData(LOperationRawDataFound) then begin
+ // Found
+ raise EAbstractMemBlockchainStorage.Create('ERR 20211117-02');
+ end;
+ // Go backward
+ LOperationRawDataSearch.opblock := LOperationRawDataFound.opblock-1;
+ FOperationsRawData_By_Block_OpBlock_Index.FindData(LOperationRawDataSearch,LOperationRawDataFound);
+ end;
+end;
+
+destructor TAbstractMemBlockchainStorage.Destroy;
+begin
+ UseMultithread := False;
+
+ FreeAndNil(FPendingToSave);
+
+ FreeAndNil(FFileMem);
+
+ FreeAndNil(FOrphansInformation_By_Orphan);
+ FreeAndNil(FBlocksInformation_By_OrphanBlock);
+ FreeAndNil(FOperationsRawData_By_RightOpHash);
+ FreeAndNil(FOperationsRawData_By_Block_OpBlock_Index);
+ FreeAndNil(FAffectedAccounts_By_Account_Block_OpBlock);
+
+ FreeAndNil(FStorageLock);
+
+ inherited;
+end;
+
+function TAbstractMemBlockchainStorage.DoBlockExists(Block: Cardinal): Boolean;
+var LFoundBlock : TBlockInformation;
+begin
+ Result := DoBlockExistsByOrphan(Block,Orphan,LFoundBlock);
+ if Not Result then begin
+ BlockNotFound(Block,Result);
+ end;
+end;
+
+function TAbstractMemBlockchainStorage.DoBlockExistsByOrphan(ABlock: Integer;
+ const AOrphan: String; var LBlockInformation: TBlockInformation): Boolean;
+var LSearch : TBlockInformation;
+ LDataPos : TAbstractMemPosition;
+begin
+ LSearch.Clear;
+ LSearch.orphan := AOrphan;
+ LSearch.operationBlock.block := ABlock;
+ Result := FBlocksInformation_By_OrphanBlock.FindData(LSearch,LDataPos,LBlockInformation);
+end;
+
+procedure TAbstractMemBlockchainStorage.DoBlockNotFound(ABlock: Integer; var AFound : Boolean);
+begin
+ // Nothing to do here
+ AFound := False;
+end;
+
+procedure TAbstractMemBlockchainStorage.DoDeleteBlockChainBlocks(StartingDeleteBlock: Cardinal);
+begin
+ FStorageLock.Acquire;
+ try
+ while DeleteBlockChainBlockExt(StartingDeleteBlock,Orphan) do inc(StartingDeleteBlock);
+ FinalizedUpdating;
+ finally
+ FStorageLock.Release;
+ end;
+end;
+
+procedure TAbstractMemBlockchainStorage.DoEraseStorage;
+begin
+ FStorageLock.Acquire;
+ Try
+ FFileMem.ClearContent(FFileMem.Is64Bits,FFileMem.MemUnitsSize);
+ FreeAndNil(FFileMem);
+ DoInitialize;
+ FinalizedUpdating;
+ Finally
+ FStorageLock.Release;
+ End;
+end;
+
+function TAbstractMemBlockchainStorage.DoFindOperation(const AOpHash: TBytes; var AOperationResume: TOperationResume): TSearchOpHashResult;
+var LSearch, LFound : TOperationRawData;
+ LPos : TAbstractMemPosition;
+ LOperation : TPCOperation;
+ LMD160Hash : TBytes;
+ LBlock, LAccount, LN_Operation : Cardinal;
+begin
+ Result := OpHash_invalid_params;
+ if not (TPCOperation.DecodeOperationHash(AOpHash,LBlock,LAccount,LN_Operation,LMD160Hash)) then Exit;
+
+ if Not BlockExists(LBlock) then Exit;
+
+ LSearch.Clear;
+ LSearch.rightOpHash := Copy(AOpHash,12,20);
+ if (FOperationsRawData_By_RightOpHash.FindData(LSearch,LPos,LFound)) then begin
+ if LFound.CreateTPCOperation(FFileMem,LOperation) then
+ Try
+ if not TPCOperation.OperationToOperationResume(LFound.block,LOperation,True,LAccount,AOperationResume) then Exit;
+ AOperationResume.NOpInsideBlock := LFound.opblock;
+ AOperationResume.Balance := -1;
+ Result := OpHash_found;
+ Finally
+ LOperation.Free;
+ End;
+ end else Result := OpHash_block_not_found;
+end;
+
+
+function TAbstractMemBlockchainStorage.DoGetAccountOperations(AAccount,
+ AMaxDepth, AStartOperation, AMaxOperations, ASearchBackwardsStartingAtBlock: Integer;
+ const AOperationsResumeList: TOperationsResumeList): Boolean;
+var LSearch,LFound : TAffectedAccount;
+ LOperation : TPCOperation;
+ LOPR : TOperationResume;
+ LPreviousBlock : Integer;
+ LOperationsHashTree : TOperationsHashTree;
+ LLastBalance : Int64;
+ LAcc : TAccount;
+ LHasFound : Boolean;
+begin
+ if AMaxOperations=0 then Exit(False);
+ if AStartOperation<0 then Exit(False);
+ Result := True;
+ LSearch.Clear;
+ LSearch.account := AAccount;
+ LAcc := Bank.SafeBox.Account(AAccount);
+
+ if Not BlockExists(LAcc.GetLastUpdatedBlock) then Exit(False);
+
+ if ASearchBackwardsStartingAtBlock>0 then begin
+ LSearch.block := ASearchBackwardsStartingAtBlock;
+ end else begin
+ LSearch.block := MAXINT;
+ end;
+ LSearch.opblock := MAXINT;
+ LFound.Clear;
+ if Not FAffectedAccounts_By_Account_Block_OpBlock.FindData(LSearch,LFound) then begin
+ if (LFound.account <> AAccount) then Exit(False);
+ end;
+ if (LFound.block = LAcc.GetLastUpdatedBlock) then begin
+ LLastBalance := LAcc.balance;
+ end else LLastBalance := -1;
+ LPreviousBlock := LFound.block;
+ repeat
+ // Process back
+ if (LFound.account<>AAccount) then Break;
+ if (LFound.block<>LPreviousBlock) then begin
+ Dec(AMaxDepth);
+ LPreviousBlock := LFound.block;
+ if (AMAxDepth=0) then Break;
+ if Not BlockExists(LFound.block) then Break;
+ end;
+ if (AStartOperation>0) then Dec(AStartOperation)
+ else begin
+ LOperationsHashTree := TOperationsHashTree.Create;
+ Try
+ if DoGetOperation(LFound.block,LFound.opblock,LOperationsHashTree) then begin
+ if LOperationsHashTree.OperationsCount=1 then begin
+ LOperation := LOperationsHashTree.GetOperation(0);
+ if TPCOperation.OperationToOperationResume(LFound.block,LOperation,True,AAccount,LOPR) then begin
+
+ LOPR.NOpInsideBlock := LFound.opblock;
+ LOPR.time := Bank.SafeBox.GetBlockInfo(LFound.block).timestamp;
+ LOPR.Block := LFound.block;
+ If LLastBalance>=0 then begin
+ LOPR.Balance := LLastBalance;
+ LLastBalance := LLastBalance - ( LOPR.Amount + LOPR.Fee );
+ end else LOPR.Balance := 0; // Undetermined
+
+ AOperationsResumeList.Add(LOPR);
+ end;
+ end;
+ end;
+ Finally
+ LOperationsHashTree.Free;
+ End;
+ Dec(AMaxOperations);
+ end;
+ LSearch.CopyFrom(LFound);
+ LHasFound := FAffectedAccounts_By_Account_Block_OpBlock.FindDataPrecessor(LSearch,LFound);
+ until (AMaxDepth=0) or (AMaxOperations=0) or (Not LHasFound);
+
+end;
+
+function TAbstractMemBlockchainStorage.DoGetBlockInformation(const ABlock : Integer;
+ var AOperationBlock: TOperationBlock; var AOperationsCount: Integer;
+ var AVolume: Int64): Boolean;
+var LBlock,LFoundBlock : TBlockInformation;
+ LDataPos : TAbstractMemPosition;
+begin
+ if Not BlockExists(ABlock) then Exit(False);
+
+ LBlock.Clear;
+ LBlock.orphan := Orphan;
+ LBlock.operationBlock.block := ABlock;
+ if FBlocksInformation_By_OrphanBlock.FindData(LBlock,LDataPos,LFoundBlock) then begin
+ AOperationBlock := LFoundBlock.operationBlock;
+ AOperationsCount := LFoundBlock.operationsCount;
+ AVolume := LFoundBlock.volume;
+ Result := True;
+ end else Result := False;
+end;
+
+function TAbstractMemBlockchainStorage.DoGetBlockOperations(ABlock,
+ AOpBlockStartIndex, AMaxOperations: Integer;
+ var AOperationBlock: TOperationBlock; var AOperationsCount: Integer;
+ var AVolume: Int64;
+ const AOperationsResumeList: TOperationsResumeList): Boolean;
+var LFound,LSearch : TOperationRawData;
+ LOperation : TPCOperation;
+ LOPR : TOperationResume;
+begin
+ //
+ if AMaxOperations=0 then Exit(False);
+
+ if Not BlockExists(ABlock) then Exit(False);
+
+ Result := True;
+ LSearch.Clear;
+ LSearch.block := ABlock;
+ LSearch.opblock := AOpBlockStartIndex;
+ LFound.Clear;
+ if not FOperationsRawData_By_Block_OpBlock_Index.FindData(LSearch,LFound) then begin
+ if LFound.block<>ABlock then Exit(False);
+ LSearch := LFound;
+ if Not FOperationsRawData_By_Block_OpBlock_Index.FindDataSuccessor(LSearch,LFound) then Exit(False);
+ if LFound.block<>ABlock then Exit(False);
+ end;
+ repeat
+ if LFound.block<>ABlock then Exit(True);
+
+ if LFound.CreateTPCOperation(FFileMem,LOperation) then
+ Try
+ if not TPCOperation.OperationToOperationResume(ABlock,LOperation,True,LOperation.SignerAccount,LOPR) then break;
+ LOPR.NOpInsideBlock := LFound.opblock;
+ LOPR.Balance := -1;
+ AOperationsResumeList.Add(LOPR);
+ Finally
+ LOperation.Free;
+ End;
+ Dec(AMaxOperations);
+ LSearch := LFound;
+ until (AMaxOperations=0) or (Not FOperationsRawData_By_Block_OpBlock_Index.FindDataSuccessor(LSearch,LFound));
+end;
+
+function TAbstractMemBlockchainStorage.DoGetOperation(const ABlock, AOpBlock: Integer; const AOperations: TOperationsHashTree): Boolean;
+var LSearch,LFound : TOperationRawData;
+ LOp : TPCOperation;
+begin
+ if Not BlockExists(ABlock) then Exit(False);
+
+ LSearch.Clear;
+ LSearch.SetToFindByBlockOpblock(ABlock,AOpBlock);
+ LFound.Clear;
+ if Not FOperationsRawData_By_Block_OpBlock_Index.FindData(LSearch,LFound) then Exit(False);
+ Result := True;
+ if LFound.CreateTPCOperation(FFileMem,LOp) then
+ try
+ AOperations.AddOperationToHashTree( LOp );
+ finally
+ LOp.Free;
+ end;
+end;
+
+function TAbstractMemBlockchainStorage.DoInitialize: Boolean;
+const CT_HEADER = 'AMBlockchain'; // 12 chars
+ CT_VERSION : Integer = $00000003; // 4 bytes
+var LfdZone : TAMZone;
+ LfdBytes : TBytes;
+ LExpectedHeader,
+ LHeader : TBytes;
+ LZoneOrphansInformation,
+ LZoneBlocksInformation_By_Block,
+ LZoneBlocksRawData_By_BlockOrphan,
+ LZoneOperationsRawData_By_RightOpHash,
+ LZoneOperationsRawData_By_Block_OpBlock,
+ LZoneAffectedAccounts_By_Account_Block_OpBlock : TAMZone;
+ LFileName : String;
+ i : Integer;
+ LCacheMem : TCacheMem;
+begin
+ Result := False;
+ if Not Assigned(FFileMem) then begin
+ if (FStorageFilename='') then begin
+ FStorageFilename := Bank.GetStorageFolder(Bank.Orphan)+PathDelim+'BlockChainStream.am_blocks';
+ end;
+
+ FFileMem := TFileMem.Create(FStorageFilename,ReadOnly);
+ FFileMem.IncreaseFileBytes := 10 * 1024*1024; // 10Mb each increase
+
+ LCacheMem := FFileMem.LockCache;
+ try
+ LCacheMem.GridCache := False;
+ LCacheMem.DefaultCacheDataBlocksSize := 1024;
+ {$IFDEF IS32BITS}
+ LCacheMem.MaxCacheSize := 5 * Int64(100 * 1024 * 1024); // 100Mb * 3 = 500Mb
+ LCacheMem.MaxCacheDataBlocks := 150000;
+ {$ELSE}
+ LCacheMem.MaxCacheSize := 10 * Int64(100 * 1024 * 1024); // 100Mb * 10 = 1Gb
+ LCacheMem.MaxCacheDataBlocks := 750000;
+ {$ENDIF};
+ LCacheMem.OnFlushedCache := OnCacheMemFlushedCache;
+ LCacheMem.OnLog := OnCacheMemLog;
+ finally
+ FFileMem.UnlockCache;
+ end;
+
+ end;
+ if Not FFileMem.HeaderInitialized then begin
+ if ReadOnly then Exit(False);
+ if not FFileMem.Initialize(True,4) then Exit(False);
+ end;
+ FreeAndNil(FPendingToSave);
+ FreeAndNil(FOrphansInformation_By_Orphan);
+ FreeAndNil(FBlocksInformation_By_OrphanBlock);
+ FreeAndNil(FOperationsRawData_By_RightOpHash);
+ FreeAndNil(FOperationsRawData_By_Block_OpBlock_Index);
+ FreeAndNil(FAffectedAccounts_By_Account_Block_OpBlock);
+
+ LZoneOrphansInformation.Clear;
+ LZoneBlocksInformation_By_Block.Clear;
+ LZoneBlocksRawData_By_BlockOrphan.Clear;
+ LZoneOperationsRawData_By_RightOpHash.Clear;
+ LZoneOperationsRawData_By_Block_OpBlock.Clear;
+ LZoneAffectedAccounts_By_Account_Block_OpBlock.Clear;
+
+ LExpectedHeader.FromString(CT_HEADER);
+ Assert(Length(LExpectedHeader)=12,'CT_HEADER Header is not 12 bytes');
+ SetLength(LExpectedHeader,16);
+ i := CT_VERSION;
+ Move(i,LExpectedHeader[12],4);
+
+ SetLength(LHeader,Length(LExpectedHeader)); // 16
+
+ if (FFileMem.ReadFirstData(LfdZone,LfdBytes))
+ and (LfdZone.size>=100) then begin
+ Move(LfdBytes[0],LHeader[0],16);
+ //
+ Move(LfdBytes[16],LZoneBlocksInformation_By_Block.position,8);
+ Move(LfdBytes[24],LZoneBlocksRawData_By_BlockOrphan,8);
+ Move(LfdBytes[32],LZoneOperationsRawData_By_RightOpHash,8);
+ Move(LfdBytes[40],LZoneOperationsRawData_By_Block_OpBlock,8);
+ Move(LfdBytes[48],LZoneAffectedAccounts_By_Account_Block_OpBlock,8);
+ Move(LfdBytes[56],LZoneOrphansInformation,8);
+ end;
+
+ if (Not CompareMem(@LExpectedHeader[0],@LHeader[0],Length(LExpectedHeader))) or
+ (Not FFileMem.Is64Bits) or
+ (LZoneOrphansInformation.position=0) or
+ (LZoneBlocksInformation_By_Block.position=0) or
+ (LZoneBlocksRawData_By_BlockOrphan.position=0) or
+ (LZoneOperationsRawData_By_RightOpHash.position=0) or
+ (LZoneOperationsRawData_By_Block_OpBlock.position=0) or
+ (LZoneAffectedAccounts_By_Account_Block_OpBlock.position=0) then begin
+ FFileMem.ClearContent(True,4);
+
+ //
+ SetLength(LfdBytes,100);
+ FillChar(LfdBytes[0],Length(LfdBytes),0);
+ LfdZone := FFileMem.New(Length(LfdBytes));
+
+ // Create
+ LZoneOrphansInformation := FFileMem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize(FFileMem));
+ LZoneBlocksInformation_By_Block := FFileMem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize(FFileMem));
+ LZoneBlocksRawData_By_BlockOrphan := FFileMem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize(FFileMem));
+ LZoneOperationsRawData_By_RightOpHash := FFileMem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize(FFileMem));
+ LZoneOperationsRawData_By_Block_OpBlock := FFileMem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize(FFileMem));
+ LZoneAffectedAccounts_By_Account_Block_OpBlock := FFileMem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize(FFileMem));
+ //
+ Move(LExpectedHeader[0],LfdBytes[0],16);
+ //
+ Move(LZoneBlocksInformation_By_Block.position ,LfdBytes[16],8);
+ Move(LZoneBlocksRawData_By_BlockOrphan.position ,LfdBytes[24],8);
+ Move(LZoneOperationsRawData_By_RightOpHash.position ,LfdBytes[32],8);
+ Move(LZoneOperationsRawData_By_Block_OpBlock.position ,LfdBytes[40],8);
+ Move(LZoneAffectedAccounts_By_Account_Block_OpBlock.position,LfdBytes[48],8);
+ Move(LZoneOrphansInformation.position ,LfdBytes[56],8);
+
+ FFileMem.Write(LfdZone.position,LfdBytes[0],Length(LfdBytes));
+ end;
+ //
+ //
+ FOrphansInformation_By_Orphan := TAMBTreeOrphanInformationByOrphan.Create(
+ FFileMem,LZoneOrphansInformation,
+ False,29,Comparer_TOrphanInformation_By_Orphan);
+ FBlocksInformation_By_OrphanBlock := TAMBTreeOperationBlockInformationByOrphanBlock.Create(
+ FFileMem,LZoneBlocksInformation_By_Block,
+ False,509,Comparer_TBlockInformation_By_OrphanBlock);
+ FOperationsRawData_By_RightOpHash := TAMBTreeTOperationRawDataByRightOpHash.Create(
+ FFileMem,LZoneOperationsRawData_By_RightOpHash,
+ False,509,Comparer_TOperationRawData_By_RightOpHash);
+ FOperationsRawData_By_Block_OpBlock_Index := TAMBTreeTOperationRawDataByBlockOpBlock_Index.Create(
+ FOperationsRawData_By_RightOpHash,LZoneOperationsRawData_By_Block_OpBlock,
+ TRUE,509,Comparer_TOperationRawData_By_Block_OpBlock);
+ FAffectedAccounts_By_Account_Block_OpBlock := TAMBTreeTAffectedAccountByAccountBlockOpBlock.Create(
+ FFileMem,LZoneAffectedAccounts_By_Account_Block_OpBlock,
+ False,509,Comparer_TAffectedAccount_By_Account_Block_OpBlock);
+
+ if FUseMultithread then begin
+ FPendingToSave := TPendingToSave.Create(Self,FOperationsRawData_By_RightOpHash,FAffectedAccounts_By_Account_Block_OpBlock);
+ end;
+
+ Result := True;
+end;
+
+function TAbstractMemBlockchainStorage.DoLoadBlockChain(Operations: TPCOperationsComp; Block: Cardinal): Boolean;
+begin
+ Result := DoLoadBlockChainExt(Operations,Block,Orphan);
+ if Not Result then BlockNotFound(Block,Result);
+end;
+
+function TAbstractMemBlockchainStorage.DoLoadBlockChainExt(
+ Operations: TPCOperationsComp; Block: Cardinal;
+ const AOrphan: String): Boolean;
+var LBlock,LFoundBlock : TBlockInformation;
+ LDataPos : TAbstractMemPosition;
+begin
+ LBlock.Clear;
+ LBlock.orphan := AOrphan;
+ LBlock.operationBlock.block := Block;
+ if FBlocksInformation_By_OrphanBlock.FindData(LBlock,LDataPos,LFoundBlock) then begin
+ LFoundBlock.ReadTPCOperationsComp(FBlocksInformation_By_OrphanBlock.AbstractMem,Operations);
+ Result := True;
+ end else Result := False;
+end;
+
+function TAbstractMemBlockchainStorage.DoMoveBlockChain(StartBlock : Cardinal; Const DestOrphan : TOrphan) : Boolean;
+var LPCOperationsComp : TPCOperationsComp;
+begin
+ Assert(Orphan<>DestOrphan,'Orphan and Destorphan are equals');
+ FStorageLock.Acquire;
+ try
+ LPCOperationsComp := TPCOperationsComp.Create(Nil);
+ try
+ while LoadBlockChainBlock(LPCOperationsComp,StartBlock) do begin
+ if Not DeleteBlockChainBlockExt(StartBlock,Orphan) then raise EAbstractMemBlockchainStorage.Create('ERR 20211117-03');
+ if Not DoSaveBlockChainExt(LPCOperationsComp,DestOrphan,FSaveStorageStats) then raise EAbstractMemBlockchainStorage.Create('ERR 20211117-04');
+ inc(StartBlock);
+ end;
+ finally
+ LPCOperationsComp.Free;
+ end;
+ Result := True;
+ FinalizedUpdating;
+ finally
+ FStorageLock.Release;
+ end;
+end;
+
+function TAbstractMemBlockchainStorage.DoSaveBlockChain(Operations: TPCOperationsComp): Boolean;
+begin
+ FStorageLock.Acquire;
+ try
+ Result := DoSaveBlockChainExt(Operations,Orphan,FSaveStorageStats);
+ FinalizedUpdating;
+ finally
+ FStorageLock.Release;
+ end;
+end;
+
+function TAbstractMemBlockchainStorage.DoSaveBlockChainExt(Operations: TPCOperationsComp; const AOrphan: String; var AStats: TBlockchainStorageStats): Boolean;
+var LBlockInformation : TBlockInformation;
+ LOperationRawData : TOperationRawData;
+ LAffectedAccount : TAffectedAccount;
+ LMemStream : TMemoryStream;
+ iOperation, iOpAccount : Integer;
+ LOp : TPCOperation;
+ Laccounts : TOrderedList;
+ LRawData : TBytes;
+ LAMZone : TAMZone;
+
+ LPendingData : TPendingData;
+ LTC : TTickCount;
+begin
+ Result := True;
+ LBlockInformation.Clear;
+ LOperationRawData.Clear;
+ LAffectedAccount.Clear;
+
+ // Add
+ LBlockInformation.Clear;
+ LBlockInformation.operationBlock := Operations.OperationBlock;
+ LBlockInformation.orphan := AOrphan;
+ LBlockInformation.operationsCount := Operations.Count;
+ LBlockInformation.volume := Operations.OperationsHashTree.TotalAmount;
+
+ // DELETE PREVIOUS:
+ DeleteBlockChainBlockExt(Operations.OperationBlock.block,AOrphan);
+
+ LMemStream := TMemoryStream.Create;
+ Try
+ Operations.SaveBlockToStorage(LMemStream);
+ SetLength(LRawData,LMemStream.Size);
+ Move(LMemStream.Memory^,LRawData[0],LMemStream.Size);
+ Finally
+ LMemStream.Free;
+ End;
+ LAMZone := FFileMem.New(Length(LRawData));
+ FFileMem.Write(LAMZone.position,LRawData[0],Length(LRawData));
+
+ LBlockInformation.rawDataPosition := LAMZone.position;
+
+ FBlocksInformation_By_OrphanBlock.AddData(LBlockInformation);
+ Inc(AStats.blockInformationCount);
+
+ // Save increment:
+ FOrphansInformation_By_Orphan.Update(AOrphan,+1);
+
+ if OrphanCompare(AOrphan,Orphan)<>0 then Exit;
+ LTC := TPlatform.GetTickCount;
+
+ for iOperation := 0 to Operations.count-1 do begin
+ LOp := Operations.Operation[iOperation];
+
+ LOperationRawData.Clear;
+ LOperationRawData.rightOpHash := Copy(LOp.RipeMD160,0,20);
+ LOperationRawData.account := LOp.SignerAccount;
+ LOperationRawData.n_operation := LOp.N_Operation;
+
+ LOperationRawData.block := Operations.OperationBlock.block;
+ LOperationRawData.opblock := iOperation;
+ LOperationRawData.opType := LOp.OpType;
+ LOperationRawData.opSavedProtocol := LOp.ProtocolVersion;
+
+ LMemStream := TMemoryStream.Create;
+ Try
+ LOp.SaveToStorage(LMemStream);
+ LOperationRawData.rawData := TStreamOp.SaveStreamToRaw(LMemStream);
+ Finally
+ LMemStream.Free;
+ End;
+ LPendingData.Clear;
+ LPendingData.operation.CopyFrom(LOperationRawData);
+ if Not Assigned(FPendingToSave) then begin
+ // Add Operation
+ if not FOperationsRawData_By_RightOpHash.AddData(LOperationRawData) then
+ raise EAbstractMemBlockchainStorage.Create(Format('Cannot add operation %d/%d of block %d - %s',[iOperation+1,Operations.Count,Operations.OperationBlock.block, LOp.ToString]));
+ Inc(AStats.operationRawDataCount);
+ end;
+ if (FLogSaveActivity) and (TPlatform.GetElapsedMilliseconds(LTC)>10000) then begin
+ LTC := TPlatform.GetTickCount;
+ TLog.NewLog(ltdebug,ClassName,Format('Saving block %d operation %d/%d - %s',[Operations.OperationBlock.block,iOperation+1,Operations.Count,FSaveStorageStats.ToString]));
+ end;
+
+ // Affected accounts:
+ Laccounts := TOrderedList.Create(False,TComparison_Cardinal);
+ try
+ LOp.AffectedAccounts(Laccounts);
+ SetLength(LPendingData.affectedAccounts,LAccounts.Count);
+ for iOpAccount:=0 to Laccounts.Count-1 do begin
+ //
+ LAffectedAccount.Clear;
+ LAffectedAccount.account := Laccounts.Items[iOpAccount];
+ LAffectedAccount.n_operation := LOp.GetAccountN_Operation(Laccounts.Items[iOpAccount]);
+ LAffectedAccount.block := Operations.OperationBlock.block;
+ LAffectedAccount.opblock := iOperation;
+
+ LPendingData.affectedAccounts[iOpAccount].CopyFrom( LAffectedAccount );
+ if Not Assigned(FPendingToSave) then begin
+ // Add affected account
+ if not FAffectedAccounts_By_Account_Block_OpBlock.AddData(LAffectedAccount) then begin
+ raise EAbstractMemBlockchainStorage.Create(Format('Cannot add affected account %d/%d in operation %d/%d of block %d - %s',
+ [iOpAccount+1,LAccounts.Count,iOperation+1,Operations.Count,Operations.OperationBlock.block,
+ LOp.ToString]));
+ end;
+ Inc(AStats.affectedAccountCount);
+ end;
+ end;
+ finally
+ Laccounts.Free;
+ end;
+ if Assigned(FPendingToSave) then begin
+ FPendingToSave.AddPendingData(LPendingData);
+ end;
+ end;
+ //
+end;
+
+procedure TAbstractMemBlockchainStorage.FillInfo(AStrings: TStrings);
+var LOrphans, LSearch : TOrphanInformation;
+begin
+ AStrings.Add(Format('Orphan "%s" from %d to %d with Orphans: %d',[
+ Orphan,FirstBlock,LastBlock,
+ FOrphansInformation_By_Orphan.Count]));
+ if FOrphansInformation_By_Orphan.FindDataLowest(LOrphans) then begin
+ repeat
+ AStrings.Add(Format('- Orphan "%s" regs: %d',[LOrphans.orphan,LOrphans.regsCounter]));
+ LSearch.CopyFrom(LOrphans)
+ until (Not (FOrphansInformation_By_Orphan.FindDataSuccessor(LSearch,LOrphans)));
+ end else AStrings.Add('No orphans');
+
+end;
+
+procedure TAbstractMemBlockchainStorage.FinalizedUpdating;
+var LTC : TTickCount;
+begin
+ if FAutoFlushCache then begin
+ LTC := TPlatform.GetTickCount;
+ FileMem.FlushCache;
+ end;
+end;
+
+function TAbstractMemBlockchainStorage.GetFirstBlockNumber: Int64;
+begin
+ Result := GetFirstBlockNumberByOrphan(Orphan);
+end;
+
+function TAbstractMemBlockchainStorage.GetFirstBlockNumberByOrphan(
+ const AOrphan: String): Int64;
+var LBlockInformation,LBlockInformationFound : TBlockInformation;
+ LPos : TAbstractMemPosition;
+begin
+ Result := -1;
+ LBlockInformation.Clear;
+ LBlockInformation.orphan := AOrphan;
+ LBlockInformation.operationBlock.block := 0;
+ if Not FBlocksInformation_By_OrphanBlock.FindData(LBlockInformation,LPos,LBlockInformationFound) then begin
+ if FBlocksInformation_By_OrphanBlock.Count<=0 then Exit(-1);
+ if LBlockInformationFound.IsOrphan(AOrphan) then Exit(LBlockInformationFound.operationBlock.block);
+ LBlockInformation := LBlockInformationFound;
+ if FBlocksInformation_By_OrphanBlock.FindDataSuccessor(LBlockInformation,LBlockInformationFound) then begin
+ if LBlockInformationFound.IsOrphan(AOrphan) then Exit(LBlockInformationFound.operationBlock.block);
+ end;
+ end else Result := LBlockInformationFound.operationBlock.block;
+end;
+
+function TAbstractMemBlockchainStorage.GetLastBlockNumber: Int64;
+begin
+ Result := GetLastBlockNumberByOrphan(Orphan);
+end;
+
+function TAbstractMemBlockchainStorage.GetLastBlockNumberByOrphan(const AOrphan: String): Int64;
+var LBlockInformation,LBlockInformationFound : TBlockInformation;
+ LPos : TAbstractMemPosition;
+begin
+ Result := -1;
+ LBlockInformation.Clear;
+ LBlockInformation.orphan := AOrphan;
+ LBlockInformation.operationBlock.block := MAXINT;
+ if Not FBlocksInformation_By_OrphanBlock.FindData(LBlockInformation,LPos,LBlockInformationFound) then begin
+ if FBlocksInformation_By_OrphanBlock.Count<=0 then Exit(-1);
+ if LBlockInformationFound.IsOrphan(AOrphan) then Exit(LBlockInformationFound.operationBlock.block);
+ end else Result := LBlockInformationFound.operationBlock.block;
+end;
+
+procedure TAbstractMemBlockchainStorage.OnCacheMemFlushedCache(
+ const ASender: TCacheMem; const AProcessDesc: String; AElapsedMilis: Int64);
+begin
+ TLog.NewLog(ltdebug,ASender.ClassName,Self.ClassName+' '+AProcessDesc)
+end;
+
+procedure TAbstractMemBlockchainStorage.OnCacheMemLog(ASender: TObject;
+ const ALog: String);
+begin
+ TLog.NewLog(ltdebug,ASender.ClassName,Self.ClassName+' '+ALog);
+end;
+
+class function TAbstractMemBlockchainStorage.OrphanCompare(const ALeft, ARight: String): Integer;
+begin
+ Result := BinStrComp(ALeft,ARight);
+end;
+
+function TAbstractMemBlockchainStorage.PendingToSave: Integer;
+begin
+ if Assigned(FPendingToSave) then begin
+ Result := FPendingToSave.PendingsCount;
+ end else Result := 0;
+end;
+
+procedure TAbstractMemBlockchainStorage.SetReadOnly(const Value: Boolean);
+begin
+ if ReadOnly=Value then Exit;
+ inherited;
+ //
+ if Assigned(FFileMem) then begin
+ FreeAndNil(FPendingToSave);
+ FreeAndNil(FFileMem);
+ Initialize;
+ end;
+end;
+
+procedure TAbstractMemBlockchainStorage.SetUseMultithread(const Value: Boolean);
+var
+ i : Integer;
+begin
+ if FUseMultithread=Value then Exit;
+ FStorageLock.Acquire;
+ Try
+ if Assigned(FPendingToSave) then begin
+ i := FPendingToSave.PendingsCount;
+ if i>0 then begin
+ TLog.NewLog(ltinfo,ClassName,Format('Finalizing use of multitrheads with %d pending jobs',[i]));
+ end;
+ while (FPendingToSave.PendingsCount>0) do begin
+ sleep(1);
+ end;
+ if i>0 then begin
+ TLog.NewLog(ltinfo,ClassName,Format('Finalized use of multitrheads with %d pending jobs',[i]));
+ end;
+ end;
+ FreeAndNil(FPendingToSave);
+ FUseMultithread := Value;
+ if FUseMultithread then begin
+ FPendingToSave := TPendingToSave.Create(Self,FOperationsRawData_By_RightOpHash,FAffectedAccounts_By_Account_Block_OpBlock);
+ end;
+ Finally
+ FStorageLock.Release;
+ End;
+end;
+
+{ TAbstractMemBlockchainStorage.TAMBTreeOperationBlockInformationByBlock }
+
+procedure TAbstractMemBlockchainStorage.TAMBTreeOperationBlockInformationByOrphanBlock.DeletedData(
+ const AData: TBlockInformation);
+begin
+ inherited;
+ if AData.rawDataPosition>0 then begin
+ AbstractMem.Dispose(AData.rawDataPosition);
+ end;
+end;
+
+function TAbstractMemBlockchainStorage.TAMBTreeOperationBlockInformationByOrphanBlock.GetBlockInformationByBlock(
+ ABlock: Integer): TBlockInformation;
+var LPos : TAbstractMemPosition;
+ LBlockSearch : TBlockInformation;
+begin
+ LBlockSearch.Clear;
+ LBlockSearch.operationBlock.block := ABlock;
+ if Not FindData(LBlockSearch,LPos,Result) then Result.Clear;
+end;
+
+function TAbstractMemBlockchainStorage.TAMBTreeOperationBlockInformationByOrphanBlock.LoadData(
+ const APosition: TAbstractMemPosition): TBlockInformation;
+var LZone : TAMZone;
+ LBytes : TBytes;
+begin
+ if APosition=0 then begin
+ Result.Clear;
+ Exit;
+ end;
+ if Not AbstractMem.GetUsedZoneInfo( APosition, False, LZone) then
+ raise EAbstractMemBTree.Create(Format('%s.LoadData Inconsistency error used zone info not found at pos %d',[Self.ClassName,APosition]));
+ SetLength(LBytes,LZone.size);
+ if AbstractMem.Read(LZone.position, LBytes[0], Length(LBytes) )<>Length(LBytes) then
+ raise EAbstractMemBTree.Create(Format('%s.LoadData Inconsistency error cannot read %d bytes at pos %d',[Self.ClassName,LZone.size,APosition]));
+ Result.Clear;
+ if not Result.FromSerialized(LBytes) then
+ raise EAbstractMemBTree.Create(Format('%s.LoadData Invalid FromSerialized call with %d bytes at pos %d',[Self.ClassName,LZone.size,APosition]));
+end;
+
+function TAbstractMemBlockchainStorage.TAMBTreeOperationBlockInformationByOrphanBlock.SaveData(
+ const AData: TBlockInformation): TAMZone;
+var LBytes : TBytes;
+begin
+ LBytes := AData.ToSerialized;
+ Result := AbstractMem.New(Length(LBytes));
+ AbstractMem.Write(Result.position,LBytes[0],Length(LBytes));
+end;
+
+{ TAbstractMemBlockchainStorage.TAMBTreeTOperationRawDataByRightOpHash }
+
+function TAbstractMemBlockchainStorage.TAMBTreeTOperationRawDataByRightOpHash.LoadData(
+ const APosition: TAbstractMemPosition): TOperationRawData;
+var LZone : TAMZone;
+ LBytes : TBytes;
+begin
+ if APosition=0 then begin
+ Result.Clear;
+ Exit;
+ end;
+ if Not AbstractMem.GetUsedZoneInfo( APosition, False, LZone) then
+ raise EAbstractMemBTree.Create(Format('%s.LoadData Inconsistency error used zone info not found at pos %d',[Self.ClassName,APosition]));
+ SetLength(LBytes,LZone.size);
+ if AbstractMem.Read(LZone.position, LBytes[0], Length(LBytes) )<>Length(LBytes) then
+ raise EAbstractMemBTree.Create(Format('%s.LoadData Inconsistency error cannot read %d bytes at pos %d',[Self.ClassName,LZone.size,APosition]));
+ Result.Clear;
+ if not Result.FromSerialized(LBytes) then
+ raise EAbstractMemBTree.Create(Format('%s.LoadData Invalid FromSerialized call with %d bytes at pos %d',[Self.ClassName,LZone.size,APosition]));
+end;
+
+function TAbstractMemBlockchainStorage.TAMBTreeTOperationRawDataByRightOpHash.SaveData(
+ const AData: TOperationRawData): TAMZone;
+var LBytes : TBytes;
+begin
+ LBytes := AData.ToSerialized;
+ Result := AbstractMem.New(Length(LBytes));
+ AbstractMem.Write(Result.position,LBytes[0],Length(LBytes));
+end;
+
+{ TAbstractMemBlockchainStorage.TAMBTreeTAffectedAccountByAccountBlockOpBlock }
+
+function TAbstractMemBlockchainStorage.TAMBTreeTAffectedAccountByAccountBlockOpBlock.LoadData(
+ const APosition: TAbstractMemPosition): TAffectedAccount;
+var LZone : TAMZone;
+ LBytes : TBytes;
+begin
+ if APosition=0 then begin
+ Result.Clear;
+ Exit;
+ end;
+ if Not AbstractMem.GetUsedZoneInfo( APosition, False, LZone) then
+ raise EAbstractMemBTree.Create(Format('%s.LoadData Inconsistency error used zone info not found at pos %d',[Self.ClassName,APosition]));
+ SetLength(LBytes,LZone.size);
+ if AbstractMem.Read(LZone.position, LBytes[0], Length(LBytes) )<>Length(LBytes) then
+ raise EAbstractMemBTree.Create(Format('%s.LoadData Inconsistency error cannot read %d bytes at pos %d',[Self.ClassName,LZone.size,APosition]));
+ Result.Clear;
+ if not Result.FromSerialized(LBytes) then
+ raise EAbstractMemBTree.Create(Format('%s.LoadData Invalid FromSerialized call with %d bytes at pos %d',[Self.ClassName,LZone.size,APosition]));
+end;
+
+function TAbstractMemBlockchainStorage.TAMBTreeTAffectedAccountByAccountBlockOpBlock.SaveData(
+ const AData: TAffectedAccount): TAMZone;
+var LBytes : TBytes;
+begin
+ LBytes := AData.ToSerialized;
+ Result := AbstractMem.New(Length(LBytes));
+ AbstractMem.Write(Result.position,LBytes[0],Length(LBytes));
+end;
+
+{ TAbstractMemBlockchainStorage.TBlockInformation }
+
+procedure TAbstractMemBlockchainStorage.TBlockInformation.Clear;
+begin
+ Self.operationBlock := CT_OperationBlock_NUL;
+ Self.orphan := '';
+ Self.operationsCount := 0;
+ Self.volume := 0;
+ Self.rawDataPosition := 0;
+end;
+
+procedure TAbstractMemBlockchainStorage.TBlockInformation.CopyFrom(const ASource: TBlockInformation);
+begin
+ Self.operationBlock := ASource.operationBlock.GetCopy;
+ Self.orphan := ASource.orphan;
+ Self.operationsCount := ASource.operationsCount;
+ Self.volume := ASource.volume;
+ Self.rawDataPosition := ASource.rawDataPosition;
+end;
+
+function TAbstractMemBlockchainStorage.TBlockInformation.CreateTPCOperationsComp(
+ AAbstractMem : TAbstractMem; ABank: TPCBank): TPCOperationsComp;
+begin
+ Result := TPCOperationsComp.Create(ABank);
+ try
+ ReadTPCOperationsComp(AAbstractMem,Result);
+ Except
+ On E:Exception do begin
+ Result.Free;
+ Raise;
+ end;
+ end;
+end;
+
+function TAbstractMemBlockchainStorage.TBlockInformation.FromSerialized(ABytes: TBytes): Boolean;
+var LStream : TStream;
+ Lsoob : Byte;
+ LBuild : Word;
+begin
+ Clear;
+ LStream := TMemoryStream.Create;
+ Try
+ TStreamOp.LoadStreamFromRaw(LStream,ABytes);
+ LStream.Position := 0;
+ LStream.Read(LBuild,2);
+ if LBuild>CT_PROTOCOL_5 then Exit(False);
+ Result := TPCOperationsComp.LoadOperationBlockFromStream(LStream,Lsoob,Self.operationBlock);
+ TStreamOp.ReadString(LStream,Self.orphan);
+ LStream.Read(Self.operationsCount,4);
+ LStream.Read(Self.volume,8);
+ LStream.Read(Self.rawDataPosition,8);
+ Finally
+ LStream.Free;
+ End;
+ Result := True;
+end;
+
+function TAbstractMemBlockchainStorage.TBlockInformation.GetRawData(
+ AAbstractMem: TAbstractMem; var ARawData: TBytes): Boolean;
+var LZone : TAMZone;
+begin
+ if Self.rawDataPosition<=0 then begin
+ Exit(False);
+ end;
+ if Not AAbstractMem.GetUsedZoneInfo( Self.rawDataPosition, False, LZone) then
+ raise EAbstractMemBlockchainStorage.Create(Format('TAbstractMemBlockchainStorage.TBlockInformation.GetRawData Inconsistency error used zone info not found at pos %d',[Self.rawDataPosition]));
+ SetLength(ARawData,LZone.size);
+ if AAbstractMem.Read(LZone.position, ARawData[0], Length(ARawData) )<>Length(ARawData) then
+ raise EAbstractMemBlockchainStorage.Create(Format('TAbstractMemBlockchainStorage.TBlockInformation.GetRawData Inconsistency error cannot read %d bytes at pos %d',[LZone.size,Self.rawDataPosition]));
+ Result := True;
+end;
+
+function TAbstractMemBlockchainStorage.TBlockInformation.IsOrphan(const AOrphan: String): Boolean;
+begin
+ Result := TAbstractMemBlockchainStorage.OrphanCompare(Self.orphan,AOrphan)=0;
+end;
+
+procedure TAbstractMemBlockchainStorage.TBlockInformation.ReadTPCOperationsComp(
+ AAbstractMem: TAbstractMem; AOperationsComp: TPCOperationsComp);
+var LStream : TStream;
+ LRaw : TBytes;
+ LErrors : String;
+begin
+ LStream := TMemoryStream.Create;
+ Try
+ Self.GetRawData(AAbstractMem,LRaw);
+ LStream.Write(LRaw[0],Length(LRaw));
+ LStream.Position := 0;
+ if Not AOperationsComp.LoadBlockFromStorage(LStream,Lerrors) then raise EAbstractMemBlockchainStorage.Create(
+ Format('Cannot read ReadTPCOperationsComp %d from storage: %s',[Self.operationBlock.block,LErrors]));
+ Finally
+ LStream.Free;
+ End;
+end;
+
+procedure TAbstractMemBlockchainStorage.TBlockInformation.SetToFindByBlock(ABlock: Integer);
+begin
+ Self.Clear;
+ Self.operationBlock.block := ABlock;
+end;
+
+function TAbstractMemBlockchainStorage.TBlockInformation.ToSerialized: TBytes;
+var LStream : TStream;
+ LBuild : Word;
+begin
+ LStream := TMemoryStream.Create;
+ Try
+ LBuild := CT_BUILD_PROTOCOL;
+ LStream.Write(LBuild,2);
+ TPCOperationsComp.SaveOperationBlockToStream(Self.operationBlock,LStream);
+ TStreamOp.WriteString(LStream,Self.orphan);
+ LStream.Write(Self.operationsCount,4);
+ LStream.Write(Self.volume,8);
+ LStream.Write(Self.rawDataPosition,8);
+ Result := TStreamOp.SaveStreamToRaw(LStream);
+ Finally
+ LStream.Free;
+ End;
+end;
+
+{ TAbstractMemBlockchainStorage.TOperationRawData }
+
+procedure TAbstractMemBlockchainStorage.TOperationRawData.Clear;
+begin
+ Self.rightOpHash := Nil;
+ Self.account := 0;
+ Self.n_operation := 0;
+ Self.block := 0;
+ Self.opblock := 0;
+ Self.opType := 0;
+ Self.opSavedProtocol := 0;
+ Self.rawData := Nil;
+end;
+
+procedure TAbstractMemBlockchainStorage.TOperationRawData.CopyFrom(const
+ ASource: TOperationRawData);
+begin
+ Self.rightOpHash := Copy(ASource.rightOpHash);
+ Self.account := ASource.account;
+ Self.n_operation := ASource.n_operation;
+ Self.block := ASource.block;
+ Self.opblock := ASource.opblock;
+ Self.opType := ASource.opType;
+ Self.opSavedProtocol := ASource.opSavedProtocol;
+ Self.rawData := Copy(ASource.rawData);
+end;
+
+function TAbstractMemBlockchainStorage.TOperationRawData.CreateTPCOperation(
+ AAbstractMem: TAbstractMem; out APCOperation: TPCOperation): Boolean;
+var LOpClass: TPCOperationClass;
+ LStream : TStream;
+begin
+ Result := false;
+ APCOperation := Nil;
+ LOpClass := TPCOperationsComp.GetOperationClassByOpType(Self.opType);
+ if Not Assigned(LOpClass) then Exit;
+ APCOperation := LOpClass.Create(Self.opSavedProtocol);
+ Try
+ LStream := TMemoryStream.Create;
+ Try
+ TStreamOp.LoadStreamFromRaw(LStream,Self.rawData);
+ LStream.Position := 0;
+ Result := APCOperation.LoadFromStorage(LStream,CT_BUILD_PROTOCOL,Nil);
+ Finally
+ LStream.Free;
+ End;
+ Finally
+ if not Result then FreeAndNil(APCOperation);
+ End;
+end;
+
+function TAbstractMemBlockchainStorage.TOperationRawData.CreateTPCOperation(AAbstractMem: TAbstractMem): TPCOperation;
+var LOpClass: TPCOperationClass;
+ LStream : TStream;
+begin
+
+ LOpClass := TPCOperationsComp.GetOperationClassByOpType(Self.opType);
+ if Not Assigned(LOpClass) then raise EAbstractMemBlockchainStorage.Create(Format('Class for OpType %d not found ',[Self.opType]));
+ Result := LOpClass.Create(Self.opSavedProtocol);
+ Try
+ LStream := TMemoryStream.Create;
+ Try
+ TStreamOp.LoadStreamFromRaw(LStream,Self.rawData);
+ LStream.Position := 0;
+ if not Result.LoadFromStorage(LStream,CT_BUILD_PROTOCOL,Nil) then raise EAbstractMemBlockchainStorage.Create(
+ Format('Cannot load TPCOperation type %s from stream ',[Result.ClassName]));
+ Finally
+ LStream.Free;
+ End;
+ Except
+ On E: Exception do begin
+ Result.Free;
+ raise;
+ end;
+ End;
+end;
+
+function TAbstractMemBlockchainStorage.TOperationRawData.FromSerialized(
+ ABytes: TBytes): Boolean;
+var LStream : TStream;
+ LBuild : Word;
+begin
+ Self.Clear;
+ LStream := TMemoryStream.Create;
+ Try
+ TStreamOp.LoadStreamFromRaw(LStream,ABytes);
+ LStream.Position := 0;
+ LStream.Read(LBuild,2);
+ if LBuild>CT_PROTOCOL_5 then Exit(False);
+ TStreamOp.ReadAnsiString(LStream,Self.rightOpHash);
+ LStream.Read(Self.account,4);
+ LStream.Read(Self.n_operation,4);
+ LStream.Read(Self.block,4);
+ LStream.Read(Self.opblock,4);
+ LStream.Read(Self.opType,2);
+ LStream.Read(Self.opSavedProtocol,2);
+ TStreamOp.ReadAnsiString(LStream,Self.rawData);
+ Finally
+ LStream.Free;
+ End;
+ Result := True;
+end;
+
+procedure TAbstractMemBlockchainStorage.TOperationRawData.SetToFindByBlockOpblock(
+ ABlock, AOpblock: Integer);
+begin
+ Self.Clear;
+ Self.block := Ablock;
+ Self.opblock := AOpblock;
+end;
+
+procedure TAbstractMemBlockchainStorage.TOperationRawData.SetToFindByRightOpHash(
+ const ARightOpHash: TBytes);
+begin
+ Self.Clear;
+ Self.rightOpHash := Copy(ARightOpHash);
+end;
+
+function TAbstractMemBlockchainStorage.TOperationRawData.ToSerialized: TBytes;
+var LStream : TStream;
+ Lraw : TRawBytes;
+ LBuild : Word;
+begin
+ LStream := TMemoryStream.Create;
+ Try
+ LBuild := CT_BUILD_PROTOCOL;
+ LStream.Write(LBuild,2);
+ TStreamOp.WriteAnsiString(LStream,Self.rightOpHash);
+ LStream.Write(Self.account,4);
+ LStream.Write(Self.n_operation,4);
+ LStream.Write(Self.block,4);
+ LStream.Write(Self.opblock,4);
+ LStream.Write(Self.opType,2);
+ LStream.Write(Self.opSavedProtocol,2);
+ TStreamOp.WriteAnsiString(LStream,Self.rawData);
+ Result := TStreamOp.SaveStreamToRaw(LStream);
+ Finally
+ LStream.Free;
+ End;
+end;
+
+{ TAbstractMemBlockchainStorage.TAffectedAccount }
+
+procedure TAbstractMemBlockchainStorage.TAffectedAccount.Clear;
+begin
+ Self.account := -1; // -1 = No account
+ Self.n_operation := 0;
+ Self.block := -1; // -1 = No block
+ Self.opblock := -1; // -1 = No opblock
+end;
+
+procedure TAbstractMemBlockchainStorage.TAffectedAccount.CopyFrom(
+ const ASource: TAffectedAccount);
+begin
+ Self.account := ASource.account;
+ Self.n_operation := ASource.n_operation;
+ Self.block := ASource.block;
+ Self.opblock := ASource.opblock;
+end;
+
+function TAbstractMemBlockchainStorage.TAffectedAccount.FromSerialized(
+ ABytes: TBytes): Boolean;
+var LStream : TStream;
+ LBuild : Word;
+begin
+ LStream := TMemoryStream.Create;
+ Try
+ TStreamOp.LoadStreamFromRaw(LStream,ABytes);
+ LStream.Position := 0;
+ LStream.Read(LBuild,2);
+ if LBuild>CT_PROTOCOL_5 then Exit(False);
+ LStream.Read(Self.account,4);
+ LStream.Read(Self.n_operation,4);
+ LStream.Read(Self.block,4);
+ LStream.Read(Self.opblock,4);
+ Finally
+ LStream.Free;
+ End;
+ Result := True;
+end;
+
+procedure TAbstractMemBlockchainStorage.TAffectedAccount.SetToFindByAccount(
+ AAccount: Integer);
+begin
+ Self.Clear;
+ Self.account := AAccount;
+end;
+
+procedure TAbstractMemBlockchainStorage.TAffectedAccount.SetToFindByAccountBlockOpblock(
+ AAccount, ABlock, AOpblock: Integer);
+begin
+ Self.Clear;
+ Self.account := AAccount;
+ Self.block := ABlock;
+ Self.opblock := AOpblock;
+end;
+
+function TAbstractMemBlockchainStorage.TAffectedAccount.ToSerialized: TBytes;
+var LStream : TStream;
+ Lraw : TRawBytes;
+ LBuild : Word;
+begin
+ LStream := TMemoryStream.Create;
+ Try
+ LBuild := CT_BUILD_PROTOCOL;
+ LStream.Write(LBuild,2);
+ LStream.Write(Self.account,4);
+ LStream.Write(Self.n_operation,4);
+ LStream.Write(Self.block,4);
+ LStream.Write(Self.opblock,4);
+ Result := TStreamOp.SaveStreamToRaw(LStream);
+ Finally
+ LStream.Free;
+ End;
+end;
+
+function TAbstractMemBlockchainStorage.TAffectedAccount.ToString: String;
+begin
+ Result := Format('Account %s (n_operation %d) on Block %d opBlock %d',[TAccountComp.AccountNumberToAccountTxtNumber(Self.account),Self.n_operation,Self.block,Self.opblock]);
+end;
+
+{ TAbstractMemBlockchainStorage.TAMBTreeOrphanInformationByOrphan }
+
+function TAbstractMemBlockchainStorage.TAMBTreeOrphanInformationByOrphan.GetRegsCountByOrphan(const AOrphan: String): Integer;
+var LSearch, LFound : TOrphanInformation;
+ LPos : TAbstractMemPosition;
+begin
+ LSearch.Clear;
+ LSearch.orphan := AOrphan;
+ if FindData(LSearch,LPos, LFound) then begin
+ Result := LFound.regsCounter;
+ end else Result := 0;
+end;
+
+function TAbstractMemBlockchainStorage.TAMBTreeOrphanInformationByOrphan.LoadData(
+ const APosition: TAbstractMemPosition): TOrphanInformation;
+var LZone : TAMZone;
+ LBytes : TBytes;
+ LStream : TStream;
+begin
+ Result.Clear;
+ if Not AbstractMem.GetUsedZoneInfo( APosition, False, LZone) then
+ raise EAbstractMemBTree.Create(Format('%s.LoadData Inconsistency error used zone info not found at pos %d',[Self.ClassName,APosition]));
+ SetLength(LBytes,LZone.size);
+ if AbstractMem.Read(LZone.position, LBytes[0], Length(LBytes) )<>Length(LBytes) then
+ raise EAbstractMemBTree.Create(Format('%s.LoadData Inconsistency error cannot read %d bytes at pos %d',[Self.ClassName,LZone.size,APosition]));
+ LStream := TMemoryStream.Create;
+ Try
+ LStream.Write(LBytes[0],Length(LBytes));
+ LStream.Position := 0;
+ TStreamOp.ReadString(LStream,Result.orphan);
+ LStream.Read(Result.regsCounter,4);
+ Finally
+ LStream.Free;
+ End;
+end;
+
+function TAbstractMemBlockchainStorage.TAMBTreeOrphanInformationByOrphan.SaveData(
+ const AData: TOrphanInformation): TAMZone;
+var
+ LBytes : TBytes;
+ LStream : TStream;
+begin
+ LStream := TMemoryStream.Create;
+ Try
+ TStreamOp.WriteString(LStream,AData.orphan);
+ LStream.Write(AData.regsCounter,4);
+ SetLength(LBytes,LStream.Size);
+ LBytes := TStreamOp.SaveStreamToRaw(LStream);
+ Finally
+ LStream.Free;
+ End;
+ Result := AbstractMem.New(Length(LBytes));
+ AbstractMem.Write(Result.position,LBytes[0],Length(LBytes));
+end;
+
+procedure TAbstractMemBlockchainStorage.TAMBTreeOrphanInformationByOrphan.Update(
+ const AOrphan: String; AIncrement: Integer);
+var LUpdate, LUpdateFound : TOrphanInformation;
+ LPos : TAbstractMemPosition;
+begin
+ LUpdate.Clear;
+ LUpdate.orphan := AOrphan;
+ if FindData(LUpdate,LPos, LUpdateFound) then begin
+ LUpdate.regsCounter := LUpdateFound.regsCounter + AIncrement;
+ DeleteData(LUpdateFound);
+ end else begin
+ Assert(AIncrement>0,'Creating an orphan with increment<=0 '+AIncrement.ToString);
+ LUpdate.regsCounter := AIncrement;
+ end;
+ LUpdate.orphan := AOrphan;
+ if not AddData(LUpdate) then raise EAbstractMemBlockchainStorage.Create(Format('Cannot update Orphan information for %s inc %d to %d',[AOrphan,AIncrement,LUpdate.regsCounter]));
+end;
+
+{ TAbstractMemBlockchainStorage.TOrphanInformation }
+
+procedure TAbstractMemBlockchainStorage.TOrphanInformation.Clear;
+begin
+ Self.orphan:='';
+ Self.regsCounter := 0;
+end;
+
+procedure TAbstractMemBlockchainStorage.TOrphanInformation.CopyFrom(
+ const ASource: TOrphanInformation);
+begin
+ Self.orphan := ASource.orphan;
+ Self.regsCounter := ASource.regsCounter;
+end;
+
+{ TAbstractMemBlockchainStorageSecondary }
+
+constructor TAbstractMemBlockchainStorageSecondary.Create(AOwner: TComponent);
+begin
+ inherited;
+ FAuxStorage := Nil;
+ FSaving := False;
+end;
+
+destructor TAbstractMemBlockchainStorageSecondary.Destroy;
+begin
+ FreeAndNil(FAuxStorage);
+ inherited;
+end;
+
+procedure TAbstractMemBlockchainStorageSecondary.DoBlockNotFound(ABlock: Integer; var AFound : Boolean);
+var LOperationsComp : TPCOperationsComp;
+begin
+ inherited;
+ AFound := False;
+ if (Assigned(FAuxStorage)) then begin
+ FSaving := True;
+ LOperationsComp := TPCOperationsComp.Create(Nil);
+ Try
+ if FAuxStorage.LoadBlockChainBlock(LOperationsComp,ABlock) then begin
+ AFound := True;
+ inherited DoSaveBlockChain(LOperationsComp);
+ end;
+ Finally
+ LOperationsComp.Free;
+ FSaving := False;
+ End;
+ end;
+end;
+
+procedure TAbstractMemBlockchainStorageSecondary.DoDeleteBlockChainBlocks(
+ StartingDeleteBlock: Cardinal);
+begin
+ inherited;
+ if Assigned(FAuxStorage) then begin
+ FAuxStorage.DeleteBlockChainBlocks(StartingDeleteBlock);
+ end;
+end;
+
+function TAbstractMemBlockchainStorageSecondary.DoInitialize: Boolean;
+ procedure FillSecondary;
+ var i, LTotal, LNotFound : Integer;
+ Ltc : TTickCount;
+ LOpComp : TPCOperationsComp;
+ begin
+ i := FAuxStorage.LastBlock;
+ if i>=Self.LastBlock then Exit;
+ TLog.NewLog(ltdebug,ClassName,Format('Start filling secondary storage with blocks from %d to %d',[i,Self.LastBlock]));
+ Ltc := TPlatform.GetTickCount;
+ LOpComp := TPCOperationsComp.Create(Nil);
+ try
+ LTotal := 0; LNotFound := 0;
+ while (i<=Self.LastBlock) do begin
+ if (Self.DoLoadBlockChain(LOpComp,i)) then begin
+ inc(LTotal);
+ FAuxStorage.SaveBlockChainBlock(LOpComp);
+ end else inc(LNotFound);
+ inc(i);
+ if TPlatform.GetElapsedMilliseconds(Ltc)>10000 then begin
+ TLog.NewLog(ltdebug,ClassName,Format('Filling secondary storage with blocks current %d to %d done %d not found %d',[i,Self.LastBlock,LTotal,LNotFound]));
+ Ltc := TPlatform.GetTickCount;
+ end;
+ end;
+ finally
+ LOpComp.Free;
+ end;
+ TLog.NewLog(ltdebug,ClassName,Format('Finalized filling secondary storage with blocks to %d done %d not found %d',[Self.LastBlock,LTotal,LNotFound]));
+ end;
+
+begin
+ Result := inherited DoInitialize;
+ if (Result) And (Not Assigned(FAuxStorage)) then begin
+ FAuxStorage := TFileStorage.Create(Self);
+ FAuxStorage.Bank := Self.Bank;
+ FAuxStorage.ReadOnly := Self.ReadOnly;
+ Result := FAuxStorage.Initialize;
+ // Try to fill secondary with newest blocks...
+ FillSecondary;
+ end;
+end;
+
+function TAbstractMemBlockchainStorageSecondary.DoMoveBlockChain(
+ StartBlock: Cardinal; const DestOrphan: TOrphan): Boolean;
+begin
+ Result := inherited;
+ if (Result) and (Assigned(FAuxStorage)) then begin
+ FAuxStorage.DeleteBlockChainBlocks(StartBlock);
+ end;
+end;
+
+function TAbstractMemBlockchainStorageSecondary.DoSaveBlockChain(
+ Operations: TPCOperationsComp): Boolean;
+begin
+ Result := inherited;
+ if (Result) and (Assigned(FAuxStorage)) and (Not FSaving) then begin
+ Result := FAuxStorage.SaveBlockChainBlock(Operations);
+ end;
+end;
+
+procedure TAbstractMemBlockchainStorageSecondary.SetReadOnly(
+ const Value: Boolean);
+begin
+ inherited;
+ if (Assigned(FAuxStorage)) then begin
+ FAuxStorage.ReadOnly := Value;
+ FAuxStorage.StorageFilename := '';
+ end;
+end;
+
+{ TAbstractMemBlockchainStorage.TPendingToSaveThread }
+
+procedure TAbstractMemBlockchainStorage.TPendingToSaveThread.BCExecute;
+var LPendingList : TList;
+ LPending, LZero : TPendingData;
+ i, nLastBatch : Integer;
+begin
+ //
+ nLastBatch := 0;
+ while (Not Terminated) do begin
+ LPendingList := FPendingToSave.FPending.LockList;
+ try
+ if LPendingList.Count>0 then begin
+ LZero := LPendingList.Items[0];
+ LPending := LPendingList.Items[LPendingList.Count-1];
+ LPendingList.Delete(LPendingList.Count-1);
+ FBusy := True;
+ if (FPendingToSave.FAMStorage.LogSaveActivity) and (TPlatform.GetElapsedMilliseconds(FPendingToSave.FLastLogTC)>10000) then begin
+
+ TLog.NewLog(ltdebug,ClassName,Format('Pendings %d (%d/%d..%d/%d) - %s',
+ [LPendingList.Count+1, LZero.operation.block, LZero.operation.opblock,
+ LPending.operation.block, LPending.operation.opblock, FPendingToSave.FAMStorage.FSaveStorageStats.ToString]));
+ FPendingToSave.FLastLogTC := TPlatform.GetTickCount;
+ FPendingToSave.FAMStorage.FSaveStorageStats.Clear;
+ end;
+ end else FBusy := False;
+ finally
+ FPendingToSave.FPending.UnlockList;
+ end;
+ if (FBusy) then begin
+ inc(nLastBatch);
+ // Here will not terminate until finished job (or raised exception)
+ DebugStep := Format('Block %d opBlock %d',[LPending.operation.block,LPending.operation.opblock]);
+ if not FPendingToSave.FOperationsRawData_By_RightOpHash.AddData(LPending.operation) then
+ raise EAbstractMemBlockchainStorage.Create(Format('Cannot add operation block %d opBlock %d',[LPending.operation.block,LPending.operation.opblock]));
+ Inc(FPendingToSave.FAMStorage.FSaveStorageStats.operationRawDataCount);
+ //
+ for i := 0 to High(LPending.affectedAccounts) do begin
+ DebugStep := Format('Block %d opBlock %d Account %d %d/%d',[LPending.operation.block,LPending.operation.opblock,LPending.affectedAccounts[i].account,i+1,Length(LPending.affectedAccounts)]);
+ if not FPendingToSave.FAffectedAccounts_By_Account_Block_OpBlock.AddData(LPending.affectedAccounts[i]) then begin
+ raise EAbstractMemBlockchainStorage.Create(Format('Cannot add affected account %d %d/%d in block %d opBlock %d',
+ [LPending.affectedAccounts[i].account,
+ i+1,Length(LPending.affectedAccounts),
+ LPending.affectedAccounts[i].block,LPending.affectedAccounts[i].opblock]));
+ end;
+ Inc(FPendingToSave.FAMStorage.FSaveStorageStats.affectedAccountCount);
+ end;
+ end else begin
+ if (nLastBatch>0) then begin
+ TLog.NewLog(ltdebug,ClassName,Format('Finished %d operations... waiting for more - %s',
+ [nLastBatch, FPendingToSave.FAMStorage.FSaveStorageStats.ToString]));
+ nLastBatch := 0;
+ FPendingToSave.FAMStorage.FSaveStorageStats.Clear;
+ FPendingToSave.FLastLogTC := FPendingToSave.FAMStorage.FSaveStorageStats.startTC;
+ FPendingToSave.ThreadHasFinishedCurrentJob; // Notify in order to flush when all threads terminated
+ end;
+ Sleep(10);
+ end;
+ end;
+end;
+
+constructor TAbstractMemBlockchainStorage.TPendingToSaveThread.Create(
+ APendingToSave: TPendingToSave);
+begin
+ FBusy := True;
+ FPendingToSave := APendingToSave;
+ inherited Create(True);
+ FreeOnTerminate := False;
+ Resume;
+end;
+
+{ TAbstractMemBlockchainStorage.TPendingToSave }
+
+procedure TAbstractMemBlockchainStorage.TPendingToSave.AddPendingData(const APendingData: TPendingData);
+var LPendings : TList;
+ LCount : Integer;
+begin
+ LPendings := FPending.LockList;
+ Try
+ LPendings.Add(APendingData);
+ LCount := LPendings.Count;
+ inc(FTotal);
+ Finally
+ FPending.UnlockList;
+ End;
+ if MaxThreads<1 then begin
+ SetMaxThreads(1);
+ repeat
+ sleep(1);
+ until PendingsCount=0;
+ SetMaxThreads(0);
+ end else SetMaxThreads( FMaxThreads );
+
+ if (MaxPendingsCount>0) And (LCount>=MaxPendingsCount) then begin
+ while (PendingsCount>=MaxPendingsCount) and (MaxPendingsCount>0) do begin
+ Sleep(10);
+ end;
+ end;
+end;
+
+constructor TAbstractMemBlockchainStorage.TPendingToSave.Create(
+ AStorage : TAbstractMemBlockchainStorage;
+ AAMBTreeTOperationRawDataByRightOpHash: TAMBTreeTOperationRawDataByRightOpHash;
+ AAMBTreeTAffectedAccountByAccountBlockOpBlock: TAMBTreeTAffectedAccountByAccountBlockOpBlock);
+begin
+ FAMStorage := AStorage;
+ FTotal := 0;
+ FMaxPendingsCount := {$IFDEF IS32BITS}10000{$ELSE}50000{$ENDIF};
+ FLastLogTC := TPlatform.GetTickCount;
+ FOperationsRawData_By_RightOpHash := AAMBTreeTOperationRawDataByRightOpHash;
+ FAffectedAccounts_By_Account_Block_OpBlock := AAMBTreeTAffectedAccountByAccountBlockOpBlock;
+ FPending := TThreadList.Create;
+ FThreads := TThreadList.Create;
+ SetMaxThreads( TCPUTool.GetLogicalCPUCount );
+end;
+
+destructor TAbstractMemBlockchainStorage.TPendingToSave.Destroy;
+var i : Integer;
+begin
+ SetMaxThreads(0);
+ i := PendingsCount;
+ if i>0 then begin
+ TLog.NewLog(lterror,ClassName,Format('ERROR: Finalizing Pending to save with %d pending operations!',[i]));
+ end;
+ if FTotal>0 then begin
+ TLog.NewLog(ltdebug,ClassName,Format('Finalizing Pending to save with %d operations saved',[FTotal]));
+ end;
+ FreeAndNil(FPending);
+ FreeAndNil(FThreads);
+ inherited;
+end;
+
+function TAbstractMemBlockchainStorage.TPendingToSave.PendingsCount: Integer;
+var LPendings : TList;
+begin
+ LPendings := FPending.LockList;
+ Try
+ Result := LPendings.Count;
+ Finally
+ FPending.UnlockList;
+ End;
+end;
+
+procedure TAbstractMemBlockchainStorage.TPendingToSave.SetMaxThreads(const Value: Integer);
+var i : Integer;
+ ListTh : TList;
+begin
+ {$IFDEF HIGHLOG}
+ if Value<>FMaxThreads then begin
+ TLog.NewLog(ltdebug,ClassName,Format('Setting muxThreads from %d to %d',[FMaxThreads,Value]));
+ end;
+ {$ENDIF}
+ if Value<0 then FMaxThreads := 0
+ else if Value>16 then FMaxThreads := 16
+ else FMaxThreads := Value;
+
+ ListTh := FThreads.LockList;
+ try
+ // Clean terminateds...
+ for i := ListTh.Count-1 downto 0 do begin
+ if ListTh.Items[i].Terminated then begin
+ ListTh.Items[i].Free;
+ ListTh.Delete(i);
+ end;
+ end;
+ // CREATE
+ while ListTh.Count;
+begin
+ if PendingsCount>0 then Exit;
+ ListTh := FThreads.LockList;
+ try
+ for i := ListTh.Count-1 downto 0 do begin
+ if ListTh.Items[i].Busy then Exit; // Still working
+ end;
+ Finally
+ FThreads.UnlockList;
+ end;
+ //
+ FAMStorage.FinalizedUpdating;
+end;
+
+{ TAbstractMemBlockchainStorage.TPendingData }
+
+procedure TAbstractMemBlockchainStorage.TPendingData.Clear;
+begin
+ Self.operation.Clear;
+ SetLength(Self.affectedAccounts,0);
+end;
+
+{ TBlockchainStorageStats }
+
+procedure TBlockchainStorageStats.AddTo(var ADest: TBlockchainStorageStats);
+begin
+ Inc(ADest.blockInformationCount,Self.blockInformationCount);
+ Inc(ADest.operationRawDataCount,Self.operationRawDataCount);
+ Inc(ADest.affectedAccountCount,Self.affectedAccountCount);
+end;
+
+procedure TBlockchainStorageStats.Clear;
+begin
+ Self.blockInformationCount := 0;
+ Self.operationRawDataCount := 0;
+ Self.affectedAccountCount := 0;
+ Self.startTC := TPlatform.GetTickCount;
+end;
+
+function TBlockchainStorageStats.ThroughputPerSecond: Double;
+var Lmilis : Int64;
+ LRend : Double;
+begin
+ Lmilis := TPlatform.GetElapsedMilliseconds(Self.startTC);
+ if LMilis>0 then begin
+ Result := ((Self.blockInformationCount + Self.operationRawDataCount + Self.affectedAccountCount) / Lmilis)*1000;
+ end else Result := 0;
+end;
+
+function TBlockchainStorageStats.ToString: String;
+begin
+ Result := format('Blocks:%d Operations:%d Accounts:%d secs:%.2f TPS:%.2f',
+ [Self.blockInformationCount,Self.operationRawDataCount,Self.affectedAccountCount,
+ TPlatform.GetElapsedMilliseconds(Self.startTC)/1000,Self.ThroughputPerSecond]);
+end;
+
+initialization
+end.
+
diff --git a/src/core/UAccounts.pas b/src/core/UAccounts.pas
index ea1e0b565..e2753af27 100644
--- a/src/core/UAccounts.pas
+++ b/src/core/UAccounts.pas
@@ -30,7 +30,9 @@ interface
UPCHardcodedRandomHashTable, UJSONFunctions,
{$IFDEF USE_ABSTRACTMEM}
UPCAbstractMem, UPCAbstractMemAccountKeys,
+ {$ELSE}
{$ENDIF}
+ UPCAccountsOrdenations,
{$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF};
Type
@@ -56,6 +58,7 @@ interface
class procedure GetRewardDistributionForNewBlock(const OperationBlock : TOperationBlock; out acc_0_miner_reward, acc_4_dev_reward : Int64; out acc_4_for_dev : Boolean);
class Function CalcSafeBoxHash(ABlocksHashBuffer : TBytesBuffer; protocol_version : Integer) : TRawBytes;
class Function AllowUseHardcodedRandomHashTable(const AHardcodedFileName : String; const AHardcodedSha256Value : TRawBytes) : Boolean;
+ class function IsValidAccountName(protocol_version : Integer; const new_name : TRawBytes; var errors : String) : Boolean;
end;
TAccount_Helper = record helper for TAccount
@@ -116,12 +119,15 @@ TAccount_Helper = record helper for TAccount
Class procedure SaveTOperationBlockToStream(const stream : TStream; const operationBlock:TOperationBlock);
Class Function LoadTOperationBlockFromStream(const stream : TStream; var operationBlock:TOperationBlock) : Boolean;
Class Function AccountToTxt(const Account : TAccount) : String;
+ Class Function AccountCanRecover(const Account: TAccount; currentBlockCount: Cardinal; ASafeboxCurrentProtocol : Integer) : Boolean;
End;
TPCSafeBox = Class;
TAccountKeyArray = array of TAccountKey;
+ TAccountList = TList;
+
// This is a class to quickly find accountkeys and their respective account number/s
{ TOrderedAccountKeysList }
@@ -216,6 +222,8 @@ TProgressNotifyManyHelper = record helper for TProgressNotifyMany
FOrderedByName : TOrderedRawList;
// OrderedAccountKeysList (Added after Build 3.0.1) allows an indexed search of public keys in the safebox with mem optimization
FOrderedAccountKeysList : TSafeboxPubKeysAndAccounts;
+ FAccountsOrderedByUpdatedBlock : TAccountsOrderedByUpdatedBlock;
+ FAccountsOrderedBySalePrice : TAccountsOrderedBySalePrice;
{$ENDIF}
FModifiedBlocksSeparatedChain : TOrderedBlockAccountList; // Used when has PreviousSafebox (Used if we are on a Separated chain)
//
@@ -245,6 +253,7 @@ TProgressNotifyManyHelper = record helper for TProgressNotifyMany
procedure SearchBlockWhenOnSeparatedChain(blockNumber : Cardinal; out blockAccount : TBlockAccount);
function GetAggregatedHashrate: TBigNum;
function GetOrderedAccountKeysList: TSafeboxPubKeysAndAccounts;
+ function GetAccount(AAccountNumber : Integer; var AAccount : TAccount) : Boolean;
protected
FTotalFee: Int64;
Procedure UpdateAccount(account_number : Cardinal; const newAccountInfo: TAccountInfo; const newName : TRawBytes; newType : Word;
@@ -257,6 +266,7 @@ TProgressNotifyManyHelper = record helper for TProgressNotifyMany
function DoUpgradeToProtocol3 : Boolean;
function DoUpgradeToProtocol4 : Boolean;
function DoUpgradeToProtocol5 : Boolean;
+ function DoUpgradeToProtocol6 : Boolean;
function BufferBlocksHash : TBytesBuffer32Safebox;
public
Constructor Create;
@@ -272,7 +282,8 @@ TProgressNotifyManyHelper = record helper for TProgressNotifyMany
Function LoadSafeBoxChunkFromStream(Stream : TStream; checkAll : Boolean; checkSafeboxHash : TRawBytes; progressNotify : TProgressNotify; previousCheckedSafebox : TPCSafebox; var ALastReadBlock : TBlockAccount; var errors : String) : Boolean;
Function LoadSafeBoxFromStream(Stream : TStream; checkAll : Boolean; var LastReadBlock : TBlockAccount; var errors : String) : Boolean; overload;
Function LoadSafeBoxFromStream(Stream : TStream; checkAll : Boolean; checkSafeboxHash : TRawBytes; progressNotify : TProgressNotify; previousCheckedSafebox : TPCSafebox; var ALastReadBlock : TBlockAccount; var errors : String) : Boolean; overload;
- Class Function LoadSafeBoxStreamHeader(Stream : TStream; var sbHeader : TPCSafeBoxHeader) : Boolean;
+ Class Function LoadSafeBoxStreamHeader(Stream : TStream; var sbHeader : TPCSafeBoxHeader; out AStreamFinalPos : Int64) : Boolean; overload;
+ Class Function LoadSafeBoxStreamHeader(Stream : TStream; var sbHeader : TPCSafeBoxHeader) : Boolean; overload;
Class Function SaveSafeBoxStreamHeader(Stream : TStream; protocol : Word; OffsetStartBlock, OffsetEndBlock, CurrentSafeBoxBlocksCount : Cardinal) : Boolean;
Class Function MustSafeBoxBeSaved(BlocksCount : Cardinal) : Boolean;
Class Function InitialSafeboxHash : TRawBytes;
@@ -280,7 +291,6 @@ TProgressNotifyManyHelper = record helper for TProgressNotifyMany
Procedure SaveSafeBoxToAStream(Stream : TStream; FromBlock, ToBlock : Cardinal);
class Function CopySafeBoxStream(Source,Dest : TStream; FromBlock, ToBlock : Cardinal; var errors : String) : Boolean;
class Function ConcatSafeBoxStream(Source1, Source2, Dest : TStream; var errors : String) : Boolean;
- class function ValidAccountName(const new_name : TRawBytes; var errors : String) : Boolean;
Function IsValidNewOperationsBlock(Const newOperationBlock : TOperationBlock; checkSafeBoxHash, checkValidOperationsBlock : Boolean; var errors : String) : Boolean;
class Function IsValidOperationBlock(Const newOperationBlock : TOperationBlock; var errors : String) : Boolean;
@@ -289,7 +299,7 @@ TProgressNotifyManyHelper = record helper for TProgressNotifyMany
Function FindAccountByName(const aName : String) : Integer; overload;
Function FindAccountByName(const aName : TRawBytes) : Integer; overload;
Function FindAccountsStartingByName(const AStartName : TRawBytes; const ARawList : TOrderedRawList; const AMax : Integer = 0) : Integer;
-
+
Procedure Clear;
Function Account(account_number : Cardinal) : TAccount;
Function GetBlock(block_number : Cardinal) : TBlockAccount;
@@ -319,7 +329,10 @@ TProgressNotifyManyHelper = record helper for TProgressNotifyMany
procedure UpdateSafeboxFileName(const ANewSafeboxFileName : String);
procedure ClearSafeboxfile;
class Function CopyAbstractMemToSafeBoxStream(ASource : TPCAbstractMem; ADestStream : TStream; AFromBlock, AToBlock : Cardinal; var AErrors : String) : Boolean;
+ property PCAbstractMem : TPCAbstractMem read FPCAbstractMem;
{$ENDIF}
+ Function AccountsOrderedByUpdatedBlock : TAccountsOrderedByUpdatedBlock;
+ Function AccountsOrderedBySalePrice : TAccountsOrderedBySalePrice;
End;
@@ -453,9 +466,12 @@ TProgressNotifyManyHelper = record helper for TProgressNotifyMany
public
class Function WriteAnsiString(Stream: TStream; const value: TRawBytes): Integer; overload;
class Function WriteAnsiString(Stream: TStream; const value: T32Bytes): Integer; overload;
+ class Function WriteString(Stream: TStream; const value: String): Integer;
+ class Function WriteTBytes(Stream: TStream; const value: TBytes): Integer;
class Function ReadAnsiString(Stream: TStream; var value: TRawBytes; ACheckLength : Integer = 0) : Integer; overload;
class Function ReadAnsiString(Stream: TStream; var value: T32Bytes): Integer; overload;
class Function ReadString(Stream: TStream; var value: String): Integer;
+ class Function ReadTBytes(Stream: TStream; var ABytes : TBytes; ACheckLength : Integer = 0): Integer;
class Function WriteAccountKey(Stream: TStream; const value: TAccountKey): Integer;
class Function ReadAccountKey(Stream: TStream; var value : TAccountKey): Integer;
class Function SaveStreamToRaw(Stream: TStream) : TRawBytes;
@@ -479,7 +495,18 @@ function Check_Safebox_Names_Consistency(sb : TPCSafeBox; const title :String; v
implementation
uses
- ULog, UAccountKeyStorage, math, UCommon, UPCOperationsBlockValidator;
+ ULog, {$IFnDEF USE_ABSTRACTMEM} UAccountKeyStorage,{$ENDIF} math, UCommon, UPCOperationsBlockValidator, UPCTemporalFileStream, UEncoding;
+
+
+{$IFDEF FPC}
+ {$DEFINE USE_BIGBLOCKS_MEM_ON_DISK}
+ // USE_BIGBLOCKS_MEM_ON_DISK directive is used in order to prevent a FreePascal issue with Heap allocation strategy that
+ // reuses big blocks of disposed memory and fragments it, this causes that when a new big block of same size that previously
+ // freeded mem is needed it will not reuse because has been fragmented...
+ // Tested on FPC version 3.2.0 (2020-11-03) and order versions
+ // Defragmention documented here: https://www.freepascal.org/docs-html/current/prog/progsu172.html
+ // This issue is not detected on current Delphi memory manager (Tested on Delphi 10.3.2)
+{$ENDIF}
{ This function is for testing purpose only.
Will check if Account Names are well assigned and stored }
@@ -873,6 +900,53 @@ class procedure TPascalCoinProtocol.CalcProofOfWork(const operationBlock: TOpera
end;
end;
+class function TPascalCoinProtocol.IsValidAccountName(protocol_version: Integer; const new_name: TRawBytes; var errors: String): Boolean;
+ { Note:
+ This function is case senstive, and only lower case chars are valid.
+ Execute a LowerCase() prior to call this function!
+ }
+Const CT_PascalCoin_Base64_Charset : RawByteString = 'abcdefghijklmnopqrstuvwxyz0123456789!@#$%^&*()-+{}[]\_:"|<>,.?/~';
+ // First char can't start with a number
+ CT_PascalCoin_FirstChar_Charset : RawByteString = 'abcdefghijklmnopqrstuvwxyz!@#$%^&*()-+{}[]\_:"|<>,.?/~';
+ CT_PascalCoin_name_min_length = 3;
+ CT_PascalCoin_name_max_length = 64;
+var i,j : Integer;
+ Lraw : TRawBytes;
+begin
+ Result := False; errors := '';
+ if (length(new_name)CT_PascalCoin_name_max_length) then begin
+ errors := 'Invalid length:'+IntToStr(Length(new_name))+' (valid from '+Inttostr(CT_PascalCoin_name_max_length)+' to '+IntToStr(CT_PascalCoin_name_max_length)+')';
+ Exit;
+ end;
+ for i:=Low(new_name) to High(new_name) do begin
+ if (i=Low(new_name)) then begin
+ j:=Low(CT_PascalCoin_FirstChar_Charset);
+ // First char can't start with a number
+ While (j<=High(CT_PascalCoin_FirstChar_Charset)) and (Ord(new_name[i])<>Ord(CT_PascalCoin_FirstChar_Charset[j])) do inc(j);
+ if (j>High(CT_PascalCoin_FirstChar_Charset)) then begin
+ // Allow Account Name as an hexadecimal value for a hash on Protocol V6 as proposed on PIP-0044
+ if Not (
+ (protocol_version>=CT_PROTOCOL_6) and
+ (new_name[i] in [Ord('0')..Ord('9')]) and
+ (length(new_name)=64) and
+ (TCrypto.HexaToRaw(new_name.ToString,Lraw))
+ ) then begin
+ errors := 'Invalid char '+Char(new_name[i])+' at first pos';
+ Exit; // Not found
+ end;
+ end;
+ end else begin
+ j:=Low(CT_PascalCoin_Base64_Charset);
+ While (j<=High(CT_PascalCoin_Base64_Charset)) and (Ord(new_name[i])<>Ord(CT_PascalCoin_Base64_Charset[j])) do inc(j);
+ if j>High(CT_PascalCoin_Base64_Charset) then begin
+ errors := 'Invalid char '+Char(new_name[i])+' at pos '+IntToStr(i);
+ Exit; // Not found
+ end;
+ end;
+ end;
+ Result := True;
+end;
+
class function TPascalCoinProtocol.IsValidMinerBlockPayload(const newBlockPayload: TRawBytes): Boolean;
var i : Integer;
begin
@@ -1135,6 +1209,30 @@ class function TStreamOp.ReadString(Stream: TStream; var value: String): Integer
value := raw.ToString;
end;
+class function TStreamOp.ReadTBytes(Stream: TStream;
+ var ABytes: TBytes; ACheckLength : Integer = 0): Integer;
+var LSize : Integer;
+begin
+ if Stream.Size - Stream.Position < 4 then begin
+ SetLength(ABytes,0);
+ Result := -1;
+ Exit;
+ end;
+ LSize := 0;
+ Stream.Read(LSize, 4);
+ if (Stream.Size - Stream.Position < LSize) OR ((ACheckLength > 0) AND (LSize <> ACheckLength)) then begin
+ Stream.Position := Stream.Position - 4; // Go back!
+ SetLength(ABytes,0);
+ Result := -1;
+ Exit;
+ end;
+ SetLength(ABytes, LSize);
+ if (LSize>0) then begin
+ Stream.ReadBuffer(ABytes[Low(ABytes)], LSize);
+ end;
+ Result := LSize+4;
+end;
+
class function TStreamOp.WriteAccountKey(Stream: TStream; const value: TAccountKey): Integer;
begin
Result := stream.Write(value.EC_OpenSSL_NID, SizeOf(value.EC_OpenSSL_NID));
@@ -1176,6 +1274,29 @@ class function TStreamOp.WriteGUID(AStream: TStream; const AGUID: TGUID): Intege
Result := 16; // GUID is 16 bytes
end;
+class function TStreamOp.WriteString(Stream: TStream;
+ const value: String): Integer;
+var LRaw : TRawBytes;
+begin
+ LRaw.FromString(value);
+ Result := WriteAnsiString(Stream,LRaw);
+end;
+
+class function TStreamOp.WriteTBytes(Stream: TStream;
+ const value: TBytes): Integer;
+Var LSize : Integer;
+begin
+ if (Length(value)>MAXINT) then begin
+ TLog.NewLog(lterror,Classname,'Invalid stream size! '+Inttostr(Length(value))+' '+MAXINT.ToString);
+ raise Exception.Create('Invalid stream size! '+Inttostr(Length(value))+' '+MAXINT.ToString);
+ end;
+ LSize := Length(value);
+ Stream.Write(LSize, 4);
+ if (LSize > 0) then
+ Stream.WriteBuffer(value[Low(value)], Length(value));
+ Result := LSize+4;
+end;
+
{ TAccountComp }
Const CT_Base58 : String = '123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz';
@@ -1267,7 +1388,7 @@ class function TAccountComp.LoadAccountFromStream(Stream: TStream; var Account:
Result := False;
if (Stream.Size - Stream.Position<8) then Exit;
Stream.Read(LSaved_protocol,SizeOf(LSaved_protocol));
- if Not (LSaved_protocol in [CT_PROTOCOL_4,CT_PROTOCOL_5]) then Exit;
+ if Not (LSaved_protocol in [CT_PROTOCOL_4..CT_PROTOCOL_MAX]) then Exit;
Stream.Read(Account.account,Sizeof(Account.account));
if TStreamOp.ReadAnsiString(Stream,raw) < 0 then Exit;
TAccountComp.RawString2AccountInfo(raw,Account.accountInfo);
@@ -1465,7 +1586,7 @@ class function TAccountComp.EqualAccounts(const account1, account2: TAccount): B
class function TAccountComp.EqualOperationBlocks(const opBlock1, opBlock2: TOperationBlock): Boolean;
begin
- Result := (opBlock1.block = opBlock1.block)
+ Result := (opBlock1.block = opBlock2.block)
And (EqualAccountKeys(opBlock1.account_key,opBlock2.account_key))
And (opBlock1.reward = opBlock2.reward)
And (opBlock1.fee = opBlock2.fee)
@@ -1498,9 +1619,10 @@ class function TAccountComp.EqualBlockAccounts(const blockAccount1, blockAccount
end;
end;
+// Deprecated
class function TAccountComp.FormatMoney(Money: Int64): String;
begin
- Result := FormatFloat('#,###0.0000',(Money/10000), TPCJSONData.JSONFormatSettings);
+ Result := TPASCEncoding.Encode(Money);
end;
class function TAccountComp.FormatMoneyDecimal(Money : Int64) : Currency;
@@ -1703,6 +1825,36 @@ class function TAccountComp.AccountToTxt(const Account: TAccount): String;
Account.account_data.ToHexaString,Account.account_seal.ToHexaString ]);
end;
+class function TAccountComp.AccountCanRecover(const Account: TAccount; currentBlockCount: Cardinal; ASafeboxCurrentProtocol : Integer) : Boolean;
+begin
+ Result := True;
+ if TAccountComp.IsAccountBlockedByProtocol(Account.account, currentBlockCount) then begin
+ Result := False; // 'account is blocked for protocol';
+ Exit;
+ end;
+ if TAccountComp.IsAccountLocked(Account.accountInfo,currentBlockCount) then begin
+ Result := False; // 'account is locked';
+ Exit;
+ end;
+ // check boundary 1 gotten from TOpRecoverFounds.DoOperation
+ if( Account.updated_on_block_active_mode + CT_RecoverFoundsWaitInactiveCount >= currentBlockCount ) then begin
+ Result := False; // 'account is active';
+ Exit;
+ end;
+ // check boundary 2 gotten from TOpRecoverFounds.DoOperation
+ if( TAccountComp.AccountBlock(Account.account) + CT_RecoverFoundsWaitInactiveCount >= currentBlockCount ) then begin
+ Result := False; // 'account block is active';
+ Exit;
+ end;
+ if (ASafeboxCurrentProtocol>CT_PROTOCOL_5) then begin
+ if (Account.balance>0) or (Length(Account.name)>0) then begin
+ Result := False; // 'Recover account is only valid for Balance 0 since Protocol 6'
+ exit;
+ end;
+ end;
+
+end;
+
class function TAccountComp.IsValidAccountInfo(const AAccountInfo: TAccountInfo; ACurrentProtocol : Word; var errors: String): Boolean;
Var s : String;
begin
@@ -1879,41 +2031,10 @@ class procedure TAccountComp.RawString2Accountkey(const rawaccstr: TRawBytes; va
{$IFNDEF VER210}
{$DEFINE DELPHIXE}
{$ENDIF}
-
-class function TAccountComp.TxtToMoney(const moneytxt: String;
- var money: Int64): Boolean;
-Var s : String;
- LPosThousand, LPosDecimal : Integer;
- LMoneyString : String;
+// Deprecated
+class function TAccountComp.TxtToMoney(const moneytxt: String; var money: Int64): Boolean;
begin
- money := 0;
- LMoneyString := Trim(moneytxt);
- if LMoneyString.Length=0 then begin
- Result := true;
- exit;
- end;
- try
- LPosThousand := LMoneyString.IndexOf( TPCJSONData.JSONFormatSettings.ThousandSeparator );
- LPosDecimal := LMoneyString.IndexOf( TPCJSONData.JSONFormatSettings.DecimalSeparator );
-
- if (LPosThousand>0) then begin
- if (LPosThousand < LPosDecimal ) then begin
- // Remove thousand values
- LMoneyString := LMoneyString.Replace(String(TPCJSONData.JSONFormatSettings.ThousandSeparator),'',[rfReplaceAll]);
- end else begin
- // Possible 15.123.456,7890 format ( coma (,) = decimal separator )
- // Remove decimal "." and convert thousand to decimal
- LMoneyString := LMoneyString.Replace(String(TPCJSONData.JSONFormatSettings.DecimalSeparator),'',[rfReplaceAll]);
- LMoneyString := LMoneyString.Replace(TPCJSONData.JSONFormatSettings.ThousandSeparator,TPCJSONData.JSONFormatSettings.DecimalSeparator,[rfReplaceAll]);
- end;
- end;
-
- money := Round( StrToFloat(LMoneyString,TPCJSONData.JSONFormatSettings)*10000 );
- Result := true;
- Except
- result := false;
- end;
-
+ Result := TPASCEncoding.TryDecode(moneytxt, money);
end;
class procedure TAccountComp.ValidsEC_OpenSSL_NID(list: TList);
@@ -2180,7 +2301,7 @@ procedure ToTBlockAccount(const source : TMemBlockAccount; block_number : Cardin
newBlocks : TOrderedBlockAccountList; // Saves final blocks values on modified blocks
namesDeleted : TOrderedRawList;
namesAdded : TOrderedRawList;
- oldBufferBlocksHash: TBytesBuffer;
+ oldBufferBlocksHash: {$IFDEF USE_BIGBLOCKS_MEM_ON_DISK}TPCTemporalFileStream{$ELSE}TBytesBuffer{$ENDIF};
oldTotalBalance: Int64;
oldTotalFee: Int64;
oldSafeBoxHash : TRawBytes;
@@ -2203,11 +2324,11 @@ function TPCSafeBox.Account(account_number: Cardinal): TAccount;
iBlock:=(Integer(account_number) DIV CT_AccountsPerBlock);
If (Assigned(FPreviousSafeBox)) then begin
SearchBlockWhenOnSeparatedChain(iBlock,blockAccount);
- Result := blockAccount.accounts[account_number MOD CT_AccountsPerBlock];
+ Result := blockAccount.accounts[account_number MOD CT_AccountsPerBlock].GetCopy;
end else begin
{$IFDEF USE_ABSTRACTMEM}
if (iBlock<0) Or (iBlock>=FPCAbstractMem.AccountsCount) then raise Exception.Create('Invalid account: '+IntToStr(account_number));
- Result := FPCAbstractMem.GetAccount(account_number);
+ Result := FPCAbstractMem.GetAccount(account_number).GetCopy;
{$ELSE}
if (iBlock<0) Or (iBlock>=FBlockAccountsList.Count) then raise Exception.Create('Invalid account: '+IntToStr(account_number));
ToTAccount(PBlockAccount(FBlockAccountsList.Items[iBlock])^.accounts[account_number MOD CT_AccountsPerBlock],account_number,Result);
@@ -2346,7 +2467,12 @@ function TPCSafeBox.AddNew(const blockChain: TOperationBlock): TBlockAccount;
Psnapshot^.newBlocks := FModifiedBlocksFinalState;
Psnapshot^.namesDeleted := FDeletedNamesSincePreviousSafebox;
Psnapshot^.namesAdded := FAddedNamesSincePreviousSafebox;
+ {$IFDEF USE_BIGBLOCKS_MEM_ON_DISK}
+ Psnapshot^.oldBufferBlocksHash := TPCTemporalFileStream.Create('oldbufferblockhash');
+ BufferBlocksHash.SaveToStream( Psnapshot^.oldBufferBlocksHash );
+ {$ELSE}
Psnapshot^.oldBufferBlocksHash := TBytesBuffer.CreateCopy(BufferBlocksHash);
+ {$ENDIF}
Psnapshot^.oldTotalBalance:=FTotalBalance;
Psnapshot^.oldTotalFee:=FTotalFee;
Psnapshot^.oldSafeBoxHash := FSafeBoxHash;
@@ -2419,6 +2545,24 @@ function TPCSafeBox.AccountsCount: Integer;
end;
end;
+function TPCSafeBox.AccountsOrderedBySalePrice: TAccountsOrderedBySalePrice;
+begin
+ {$IFDEF USE_ABSTRACTMEM}
+ Result := FPCAbstractMem.AccountsOrderedBySalePrice;
+ {$ELSE}
+ Result := FAccountsOrderedBySalePrice;
+ {$ENDIF}
+end;
+
+function TPCSafeBox.AccountsOrderedByUpdatedBlock: TAccountsOrderedByUpdatedBlock;
+begin
+ {$IFDEF USE_ABSTRACTMEM}
+ Result := FPCAbstractMem.AccountsOrderedByUpdatedBlock;
+ {$ELSE}
+ Result := FAccountsOrderedByUpdatedBlock;
+ {$ENDIF}
+end;
+
function TPCSafeBox.GetBlock(block_number: Cardinal): TBlockAccount;
begin
StartThreadSafe;
@@ -2577,6 +2721,8 @@ function TPCSafeBox.CanUpgradeToProtocol(newProtocolVersion : Word) : Boolean;
Result := (FCurrentProtocol=CT_PROTOCOL_3) And (BlocksCount >= CT_Protocol_Upgrade_v4_MinBlock);
end else if (newProtocolVersion=CT_PROTOCOL_5) then begin
Result := (FCurrentProtocol=CT_PROTOCOL_4) And (BlocksCount >= CT_Protocol_Upgrade_v5_MinBlock);
+ end else if (newProtocolVersion=CT_PROTOCOL_6) then begin
+ Result := (FCurrentProtocol=CT_PROTOCOL_5) And (BlocksCount >= CT_Protocol_Upgrade_v6_MinBlock);
end else Result := False;
end;
@@ -2832,6 +2978,8 @@ constructor TPCSafeBox.Create;
FBlockAccountsList := TList.Create;
FAggregatedHashrate := TBigNum.Create(0);
FOrderedByName := TOrderedRawList.Create;
+ FAccountsOrderedByUpdatedBlock := TAccountsOrderedByUpdatedBlock.Create(GetAccount);
+ FAccountsOrderedBySalePrice := TAccountsOrderedBySalePrice.Create(GetAccount);
{$ENDIF}
FListOfOrderedAccountKeysList := TList.Create;
FCurrentProtocol := CT_PROTOCOL_1;
@@ -2875,6 +3023,11 @@ destructor TPCSafeBox.Destroy;
FreeAndNil(FAddedNamesSincePreviousSafebox);
FreeAndNil(FDeletedNamesSincePreviousSafebox);
FreeAndNil(FSubChains);
+ {$IFnDEF USE_ABSTRACTMEM}
+ FreeAndNil(FAccountsOrderedByUpdatedBlock);
+ FreeAndNil(FAccountsOrderedBySalePrice);
+ {$ENDIF}
+
If Assigned(FPreviousSafeBox) then begin
FPreviousSafeBox.FSubChains.Remove(Self); // Remove from current snapshot
FPreviousSafeBox := Nil;
@@ -2920,7 +3073,13 @@ procedure TPCSafeBox.SetToPrevious(APreviousSafeBox: TPCSafeBox; StartBlock: Car
//
FPreviousSafeBox.FSubChains.Add(Self);
//
+ {$IFDEF USE_BIGBLOCKS_MEM_ON_DISK}
+ BufferBlocksHash.Clear;
+ BufferBlocksHash.LoadFromStream( Psnapshot^.oldBufferBlocksHash );
+ {$ELSE}
BufferBlocksHash.CopyFrom( Psnapshot^.oldBufferBlocksHash );
+ {$ENDIF}
+
FTotalBalance := Psnapshot^.oldTotalBalance;
FTotalFee := Psnapshot^.oldTotalFee;
FSafeBoxHash := Psnapshot^.oldSafeBoxHash;
@@ -2971,7 +3130,7 @@ procedure TPCSafeBox.CommitToPrevious;
// Start deleting:
For i:=0 to DeletedNamesList.Count-1 do begin
{$IFDEF USE_ABSTRACTMEM}
- FPreviousSafebox.FPCAbstractMem.AccountsNames.Remove(DeletedNamesList.Get(i).ToString);
+ FPreviousSafebox.FPCAbstractMem.AccountsNames.DeleteAccountName(DeletedNamesList.Get(i).ToString);
{$ELSE}
FPreviousSafebox.FOrderedByName.Remove(DeletedNamesList.Get(i));
{$ENDIF}
@@ -2979,7 +3138,7 @@ procedure TPCSafeBox.CommitToPrevious;
// Finally adding
For i:=0 to AddedNamesList.Count-1 do begin
{$IFDEF USE_ABSTRACTMEM}
- FPreviousSafebox.FPCAbstractMem.AccountsNames.Add(AddedNamesList.Get(i).ToString,AddedNamesList.GetTag(i));
+ FPreviousSafebox.FPCAbstractMem.AccountsNames.AddNameAndNumber(AddedNamesList.Get(i).ToString,AddedNamesList.GetTag(i));
{$ELSE}
FPreviousSafebox.FOrderedByName.Add(AddedNamesList.Get(i),AddedNamesList.GetTag(i));
{$ENDIF}
@@ -3114,19 +3273,23 @@ procedure TPCSafeBox.RollBackToSnapshot(snapshotBlock: Cardinal);
Procedure UndoAddedDeletedNames(AddedNamesList,DeletedNamesList : TOrderedRawList);
Var i,j : Integer;
+ {$IFDEF USE_ABSTRACTMEM}
+ Laninfo : TAccountNameInfo;
+ {$ELSE}
+ {$ENDIF}
Begin
// Start adding
For i:=0 to AddedNamesList.Count-1 do begin
// It was added, so we MUST FIND on current names list
{$IFDEF USE_ABSTRACTMEM}
- If Not FPCAbstractMem.AccountsNames.FindByName(AddedNamesList.Get(i).ToString,j) then begin
+ If Not FPCAbstractMem.AccountsNames.FindByName(AddedNamesList.Get(i).ToString,Laninfo) then begin
// ERROR: It has been added, why we not found???
If DeletedNamesList.Find(AddedNamesList.Get(i),j) then begin
end else begin
TLog.NewLog(lterror,ClassName,Format('ERROR DEV 20180319-1 Name %s not found at account:%d',[AddedNamesList.Get(i).ToPrintable,AddedNamesList.GetTag(i)]));
end;
end else begin
- FPCAbstractMem.AccountsNames.Delete(j);
+ FPCAbstractMem.AccountsNames.DeleteData(Laninfo);
end;
{$ELSE}
If Not FOrderedByName.Find(AddedNamesList.Get(i),j) then begin
@@ -3142,15 +3305,14 @@ procedure TPCSafeBox.RollBackToSnapshot(snapshotBlock: Cardinal);
For i:=0 to DeletedNamesList.Count-1 do begin
{$IFDEF USE_ABSTRACTMEM}
// It has been deleted, we MUST NOT FIND on current names list
- If FPCAbstractMem.AccountsNames.FindByName(DeletedNamesList.Get(i).ToString,j) then begin
- // It has been deleted... now is found
- If (FPCAbstractMem.AccountsNames.Item[j].accountNumber<>DeletedNamesList.GetTag(i)) then begin
+ If FPCAbstractMem.AccountsNames.FindByName(DeletedNamesList.Get(i).ToString,Laninfo) then begin
+ if Laninfo.accountNumber<>DeletedNamesList.GetTag(i) then begin
// ERROR: It has been deleted, why is found with another account???
- TLog.NewLog(lterror,ClassName,Format('ERROR DEV 20180319-2 Name %s found at account:%d <> saved account:%d',[DeletedNamesList.Get(i).ToPrintable,DeletedNamesList.GetTag(i),FPCAbstractMem.AccountsNames.Item[j].accountNumber]));
+ TLog.NewLog(lterror,ClassName,Format('ERROR DEV 20180319-2 Name %s found at account:%d <> saved account:%d',[DeletedNamesList.Get(i).ToPrintable,DeletedNamesList.GetTag(i),Laninfo.accountNumber]));
end;
end;
// Add with Info of previous account with name (saved at Tag value)
- FPCAbstractMem.AccountsNames.Add(DeletedNamesList.Get(i).ToString,DeletedNamesList.GetTag(i));
+ FPCAbstractMem.AccountsNames.AddNameAndNumber(DeletedNamesList.Get(i).ToString,DeletedNamesList.GetTag(i));
{$ELSE}
// It has been deleted, we MUST NOT FIND on current names list
If FOrderedByName.Find(DeletedNamesList.Get(i),j) then begin
@@ -3345,6 +3507,13 @@ function TPCSafeBox.DoUpgradeToProtocol5: Boolean;
TLog.NewLog(ltInfo,ClassName,'End Upgraded to protocol 5 - New safeboxhash:'+TCrypto.ToHexaString(FSafeBoxHash));
end;
+function TPCSafeBox.DoUpgradeToProtocol6: Boolean;
+begin
+ FCurrentProtocol := CT_PROTOCOL_6;
+ Result := True;
+ TLog.NewLog(ltInfo,ClassName,'End Upgraded to protocol 6 - New safeboxhash:'+TCrypto.ToHexaString(FSafeBoxHash));
+end;
+
function TPCSafeBox.BufferBlocksHash: TBytesBuffer32Safebox;
begin
{$IFnDEF USE_ABSTRACTMEM}
@@ -3391,6 +3560,9 @@ function TPCSafeBox.LoadSafeBoxChunkFromStream(Stream : TStream; checkAll : Bool
tc := TPlatform.GetTickCount;
StartThreadSafe;
try
+ {$IFDEF USE_ABSTRACTMEM}
+ FPCAbstractMem.SavingNewSafeboxMode := True;
+ {$ENDIF}
LStartTickCount := tc;
// Read Header info
If not LoadSafeBoxStreamHeader(Stream,sbHeader) then begin
@@ -3405,7 +3577,7 @@ function TPCSafeBox.LoadSafeBoxChunkFromStream(Stream : TStream; checkAll : Bool
if sbHeader.blocksCountCT_PROTOCOL_MAX then begin
+ errors := 'Invalid protocol version or corrupted stream ('+IntToStr(sbHeader.protocol)+')';
+ exit;
+ end else FCurrentProtocol := sbHeader.protocol;
end;
if sbHeader.IsAChunk then begin
if (sbHeader.startBlock<>BlocksCount) then begin
@@ -3500,16 +3674,16 @@ function TPCSafeBox.LoadSafeBoxChunkFromStream(Stream : TStream; checkAll : Bool
//
// check valid
If (Length(LBlock.accounts[iacc].name)>0) then begin
- if Not TPCSafeBox.ValidAccountName(LBlock.accounts[iacc].name,aux_errors) then begin
+ if Not TPascalCoinProtocol.IsValidAccountName(CurrentProtocol,LBlock.accounts[iacc].name,aux_errors) then begin
errors := errors + ' > Invalid name "'+LBlock.accounts[iacc].name.ToPrintable+'": '+aux_errors;
Exit;
end;
{$IFDEF USE_ABSTRACTMEM}
- if FPCAbstractMem.AccountsNames.IndexOf( LBlock.accounts[iacc].name.ToString )>=0 then begin
+ if FPCAbstractMem.AccountsNames.FindByName(LBlock.accounts[iacc].name.ToString ) then begin
errors := errors + ' Duplicate name "'+LBlock.accounts[iacc].name.ToPrintable+'"';
Exit;
end;
- FPCAbstractMem.AccountsNames.Add(LBlock.accounts[iacc].name.ToString,LBlock.accounts[iacc].account);
+ FPCAbstractMem.AccountsNames.AddNameAndNumber(LBlock.accounts[iacc].name.ToString,LBlock.accounts[iacc].account);
{$ELSE}
if FOrderedByName.IndexOf(LBlock.accounts[iacc].name)>=0 then begin
errors := errors + ' Duplicate name "'+LBlock.accounts[iacc].name.ToPrintable+'"';
@@ -3546,9 +3720,9 @@ function TPCSafeBox.LoadSafeBoxChunkFromStream(Stream : TStream; checkAll : Bool
if ((iblock + (CT_BankToDiskEveryNBlocks * 10)) >= sbHeader.blockscount) then begin
{$ENDIF}
{$IFDEF ASSUME_VALID_POW_OLD_PROTOCOLS}
- LAddToMultiThreadOperationsBlockValidator := (LUseMultiThreadOperationsBlockValidator) and (LBlock.blockchainInfo.protocol_version>=CT_PROTOCOL_5) and (Assigned(LPCOperationsBlockValidator));
+ LAddToMultiThreadOperationsBlockValidator := False;
{$ELSE}
- LAddToMultiThreadOperationsBlockValidator := (LUseMultiThreadOperationsBlockValidator) and (LBlock.blockchainInfo.protocol_version>=CT_PROTOCOL_4) and (Assigned(LPCOperationsBlockValidator));
+ LAddToMultiThreadOperationsBlockValidator := (LUseMultiThreadOperationsBlockValidator) and (LBlock.blockchainInfo.protocol_version=CT_PROTOCOL_4) and (Assigned(LPCOperationsBlockValidator));
{$ENDIF}
If not IsValidNewOperationsBlock(LBlock.blockchainInfo,False,Not LAddToMultiThreadOperationsBlockValidator,aux_errors) then begin
errors := errors + ' > ' + aux_errors;
@@ -3594,6 +3768,7 @@ function TPCSafeBox.LoadSafeBoxChunkFromStream(Stream : TStream; checkAll : Bool
Exit;
end;
end;
+
// Add
{$IFDEF USE_ABSTRACTMEM}
FPCAbstractMem.SetBlockAccount(LBlock);
@@ -3604,6 +3779,17 @@ function TPCSafeBox.LoadSafeBoxChunkFromStream(Stream : TStream; checkAll : Bool
// BufferBlocksHash fill with data
j := (length(LBlock.block_hash)*(iBlock));
BufferBlocksHash.Replace( j, LBlock.block_hash[0], 32 );
+ for j := low(LBlock.accounts) to High(LBlock.accounts) do begin
+ FAccountsOrderedByUpdatedBlock.Update(
+ LBlock.accounts[j].account,
+ 0,
+ LBlock.accounts[j].updated_on_block_active_mode);
+ FAccountsOrderedBySalePrice.UpdateAccountBySalePrice(
+ LBlock.accounts[j].account,
+ CT_AccountInfo_NUL,
+ LBlock.accounts[j].accountInfo
+ );
+ end;
{$ENDIF}
for j := low(LBlock.accounts) to High(LBlock.accounts) do begin
AccountKeyListAddAccounts(LBlock.accounts[j].accountInfo.accountKey,[LBlock.accounts[j].account]);
@@ -3616,7 +3802,7 @@ function TPCSafeBox.LoadSafeBoxChunkFromStream(Stream : TStream; checkAll : Bool
finally
LBlockHashRate.Free;
end;
- // Upgrade to Protocol 4,5... step:
+ // Upgrade to Protocol 4,5... step:CT_PROTOCOL_5
if (LBlock.blockchainInfo.protocol_version>FCurrentProtocol) then begin
if (LBlock.blockchainInfo.protocol_version = CT_PROTOCOL_4) then begin
FCurrentProtocol := CT_PROTOCOL_4;
@@ -3627,7 +3813,6 @@ function TPCSafeBox.LoadSafeBoxChunkFromStream(Stream : TStream; checkAll : Bool
// Assign to previous
LPreviousProofOfWork := LBlock.blockchainInfo.proof_of_work;
end; // For iBlock ...
-
if Assigned(LPCOperationsBlockValidator) then begin
repeat
LPCOperationsBlockValidator.GetStatus(LValidatedOPOk, LValidatedOPError, LValidatedOPPending);
@@ -3689,6 +3874,9 @@ function TPCSafeBox.LoadSafeBoxChunkFromStream(Stream : TStream; checkAll : Bool
if Not Result then Clear else errors := '';
End;
Finally
+ {$IFDEF USE_ABSTRACTMEM}
+ FPCAbstractMem.SavingNewSafeboxMode := False;
+ {$ENDIF}
EndThreadSave;
end;
TLog.NewLog(ltdebug,ClassName,Format('Finalized read Safebox from blocks %d to %d (total %d blocks) in %.2f seconds',
@@ -3697,8 +3885,16 @@ function TPCSafeBox.LoadSafeBoxChunkFromStream(Stream : TStream; checkAll : Bool
function TPCSafeBox.LoadSafeBoxFromStream(Stream : TStream; checkAll : Boolean; checkSafeboxHash : TRawBytes; progressNotify : TProgressNotify; previousCheckedSafebox : TPCSafebox; var ALastReadBlock : TBlockAccount; var errors : String) : Boolean;
+var Ltc : TTickCount;
begin
+ Ltc := TPlatform.GetTickCount;
Result := LoadSafeBoxChunkFromStream(Stream,checkAll,checkSafeboxHash,progressNotify,previousCheckedSafebox,ALastReadBlock,errors);
+ if Result then begin
+ while LoadSafeBoxChunkFromStream(Stream,checkAll,checkSafeboxHash,progressNotify,previousCheckedSafebox,ALastReadBlock,errors) do begin
+ TLog.NewLog(ltdebug,ClassName,Format('Loading safebox from stream... %.2f secs',[TPlatform.GetElapsedMilliseconds(Ltc)/1000]));
+ end;
+ end;
+ TLog.NewLog(ltdebug,ClassName,Format('Finalized Loading safebox from stream in %.2f secs',[TPlatform.GetElapsedMilliseconds(Ltc)/1000]));
end;
function TPCSafeBox.LoadSafeBoxFromStream(Stream: TStream; checkAll: Boolean; var LastReadBlock: TBlockAccount; var errors: String): Boolean;
@@ -3708,7 +3904,13 @@ function TPCSafeBox.LoadSafeBoxFromStream(Stream: TStream; checkAll: Boolean; va
Result := LoadSafeBoxFromStream(Stream,checkAll,Nil,pn,Nil,LastReadBlock,errors);
end;
-class function TPCSafeBox.LoadSafeBoxStreamHeader(Stream: TStream; var sbHeader : TPCSafeBoxHeader) : Boolean;
+class function TPCSafeBox.LoadSafeBoxStreamHeader(Stream: TStream; var sbHeader: TPCSafeBoxHeader): Boolean;
+var LPos : Int64;
+begin
+ Result := LoadSafeBoxStreamHeader(Stream,sbHeader,LPos);
+end;
+
+class function TPCSafeBox.LoadSafeBoxStreamHeader(Stream: TStream; var sbHeader : TPCSafeBoxHeader; out AStreamFinalPos : Int64) : Boolean;
// This function reads SafeBox stream info and sets position at offset start zone if valid, otherwise sets position to actual position
Var w : Word;
raw : TRawBytes;
@@ -3724,7 +3926,7 @@ class function TPCSafeBox.LoadSafeBoxStreamHeader(Stream: TStream; var sbHeader
if (raw.ToPrintable<>CT_MagicIdentificator) then exit;
if Stream.Size<8 then exit;
Stream.Read(w,SizeOf(w));
- if not (w in [CT_PROTOCOL_1,CT_PROTOCOL_2,CT_PROTOCOL_3,CT_PROTOCOL_4,CT_PROTOCOL_5]) then exit;
+ if not (w in [CT_PROTOCOL_1..CT_PROTOCOL_MAX]) then exit;
sbHeader.protocol := w;
Stream.Read(safeBoxBankVersion,2);
if safeBoxBankVersion<>CT_SafeBoxBankVersion then exit;
@@ -3741,6 +3943,7 @@ class function TPCSafeBox.LoadSafeBoxStreamHeader(Stream: TStream; var sbHeader
If (Stream.SizeCT_PascalCoin_name_max_length) then begin
- errors := 'Invalid length:'+IntToStr(Length(new_name))+' (valid from '+Inttostr(CT_PascalCoin_name_max_length)+' to '+IntToStr(CT_PascalCoin_name_max_length)+')';
- Exit;
- end;
- for i:=Low(new_name) to High(new_name) do begin
- if (i=Low(new_name)) then begin
- j:=Low(CT_PascalCoin_FirstChar_Charset);
- // First char can't start with a number
- While (j<=High(CT_PascalCoin_FirstChar_Charset)) and (Ord(new_name[i])<>Ord(CT_PascalCoin_FirstChar_Charset[j])) do inc(j);
- if j>High(CT_PascalCoin_FirstChar_Charset) then begin
- errors := 'Invalid char '+Char(new_name[i])+' at first pos';
- Exit; // Not found
- end;
- end else begin
- j:=Low(CT_PascalCoin_Base64_Charset);
- While (j<=High(CT_PascalCoin_Base64_Charset)) and (Ord(new_name[i])<>Ord(CT_PascalCoin_Base64_Charset[j])) do inc(j);
- if j>High(CT_PascalCoin_Base64_Charset) then begin
- errors := 'Invalid char '+Char(new_name[i])+' at pos '+IntToStr(i);
- Exit; // Not found
- end;
- end;
- end;
- Result := True;
-end;
var _initialSafeboxHash : TRawBytes = Nil;
@@ -4220,7 +4386,12 @@ function TPCSafeBox.IsValidNewOperationsBlock(const newOperationBlock: TOperatio
errors := 'Invalid PascalCoin protocol version: '+IntToStr( newOperationBlock.protocol_version )+' Current: '+IntToStr(CurrentProtocol)+' Previous:'+IntToStr(lastBlock.protocol_version);
exit;
end;
- If (newOperationBlock.protocol_version=CT_PROTOCOL_5) then begin
+ If (newOperationBlock.protocol_version=CT_PROTOCOL_6) then begin
+ If (newOperationBlock.blockCT_PROTOCOL_3))
or ((newOperationBlock.block = CT_Protocol_Upgrade_v4_MinBlock) and (newOperationBlock.protocol_version<>CT_PROTOCOL_4))
or ((newOperationBlock.block = CT_Protocol_Upgrade_v5_MinBlock) and (newOperationBlock.protocol_version<>CT_PROTOCOL_5))
+ or ((newOperationBlock.block = CT_Protocol_Upgrade_v6_MinBlock) and (newOperationBlock.protocol_version<>CT_PROTOCOL_6))
then begin
errors := Format('In block %d protocol must be upgraded! Current %d',[newOperationBlock.block,newOperationBlock.protocol_version]);
exit;
@@ -4330,7 +4502,12 @@ class function TPCSafeBox.IsValidOperationBlock(const newOperationBlock: TOperat
// fee: Cannot be checked only with the safebox
// Checking valid protocol version
// protocol available is not checked
- if (newOperationBlock.block >= CT_Protocol_Upgrade_v5_MinBlock) then begin
+ if (newOperationBlock.block >= CT_Protocol_Upgrade_v6_MinBlock) then begin
+ if Not newOperationBlock.protocol_version = CT_PROTOCOL_6 then begin
+ errors := Format('Invalid protocol version at block %d Found:%d Expected:%d',[newOperationBlock.block,newOperationBlock.protocol_version,CT_PROTOCOL_6]);
+ exit;
+ end;
+ end else if (newOperationBlock.block >= CT_Protocol_Upgrade_v5_MinBlock) then begin
if Not newOperationBlock.protocol_version = CT_PROTOCOL_5 then begin
errors := Format('Invalid protocol version at block %d Found:%d Expected:%d',[newOperationBlock.block,newOperationBlock.protocol_version,CT_PROTOCOL_5]);
exit;
@@ -4418,9 +4595,9 @@ function TPCSafeBox.GetActualTargetHash(protocolVersion : Word): TRawBytes;
tsReal := (ts1 - ts2);
If (protocolVersion=CT_PROTOCOL_1) then begin
Result := TPascalCoinProtocol.GetNewTarget(tsTeorical, tsReal,protocolVersion,False,TPascalCoinProtocol.TargetFromCompact(lastBlock.compact_target,lastBlock.protocol_version));
- end else if (protocolVersion<=CT_PROTOCOL_5) then begin
+ end else if (protocolVersion<=CT_PROTOCOL_MAX) then begin
CalcBack := CalcBack DIV CT_CalcNewTargetLimitChange_SPLIT;
- If CalcBack=0 then CalcBack := 1;
+ If CalcBack<=0 then CalcBack := 1;
ts2 := GetBlockInfo(BlocksCount-CalcBack-1).timestamp;
tsTeoricalStop := (CalcBack * CT_NewLineSecondsAvg);
tsRealStop := (ts1 - ts2);
@@ -4443,7 +4620,7 @@ function TPCSafeBox.GetActualTargetHash(protocolVersion : Word): TRawBytes;
end;
end;
end else begin
- Raise Exception.Create('ERROR DEV 20180306-1 Protocol not valid');
+ Raise Exception.Create('ERROR DEV 20180306-1 Protocol not valid: '+IntToStr(protocolVersion));
end;
end;
end;
@@ -4497,11 +4674,11 @@ function TPCSafeBox.GetBlockInfo(ABlockNumber: Cardinal): TOperationBlock;
If (Assigned(FPreviousSafeBox)) then begin
if (ABlockNumber<0) Or (ABlockNumber>=BlocksCount) then raise Exception.Create('Invalid block number for GetBlockInfo chain: '+inttostr(ABlockNumber)+' max: '+IntToStr(BlocksCount-1));
SearchBlockWhenOnSeparatedChain(ABlockNumber,LBlock);
- Result := LBlock.blockchainInfo;
+ Result := LBlock.blockchainInfo.GetCopy;
end else begin
{$IFDEF USE_ABSTRACTMEM}
if (ABlockNumber<0) Or (ABlockNumber>=FPCAbstractMem.BlocksCount) then raise Exception.Create('Invalid GetBlockInfo block number: '+inttostr(ABlockNumber)+' max: '+IntToStr(FPCAbstractMem.BlocksCount-1));
- Result := FPCAbstractMem.GetBlockInfo(ABlockNumber).operationBlock;
+ Result := FPCAbstractMem.GetBlockInfo(ABlockNumber).operationBlock.GetCopy;
{$ELSE}
if (ABlockNumber<0) Or (ABlockNumber>=FBlockAccountsList.Count) then raise Exception.Create('Invalid GetBlockInfo block number: '+inttostr(ABlockNumber)+' max: '+IntToStr(FBlockAccountsList.Count-1));
ToTBlockAccount(PBlockAccount(FBlockAccountsList.Items[ABlockNumber])^,ABlockNumber,LBlock);
@@ -4513,6 +4690,12 @@ function TPCSafeBox.GetBlockInfo(ABlockNumber: Cardinal): TOperationBlock;
end;
end;
+function TPCSafeBox.GetAccount(AAccountNumber: Integer; var AAccount: TAccount): Boolean;
+begin
+ AAccount := Account(AAccountNumber).GetCopy;
+ Result := True;
+end;
+
function TPCSafeBox.GetActualCompactTargetHash(protocolVersion : Word): Cardinal;
begin
Result := TPascalCoinProtocol.TargetToCompact(GetActualTargetHash(protocolVersion),protocolVersion);
@@ -4526,10 +4709,13 @@ function TPCSafeBox.FindAccountByName(const aName: String): Integer;
function TPCSafeBox.FindAccountByName(const aName: TRawBytes): Integer;
Var i,j,k : Integer;
Psnapshot : PSafeboxSnapshot;
+ {$IFDEF USE_ABSTRACTMEM}
+ Laninfo : TAccountNameInfo;
+ {$ENDIF}
begin
{$IFDEF USE_ABSTRACTMEM}
- i := FPCAbstractMem.AccountsNames.IndexOf(aName.ToString);
- if i>=0 then Result := FPCAbstractMem.AccountsNames.Item[i].accountNumber
+ if FPCAbstractMem.AccountsNames.FindByName(aName.ToString,Laninfo) then
+ Result := Laninfo.accountNumber
{$ELSE}
i := FOrderedByName.IndexOf(aName);
if i>=0 then Result := FOrderedByName.GetTag(i)
@@ -4584,26 +4770,24 @@ function TPCSafeBox.FindAccountByName(const aName: TRawBytes): Integer;
function TPCSafeBox.FindAccountsStartingByName(const AStartName: TRawBytes;
const ARawList: TOrderedRawList; const AMax: Integer = 0): Integer;
-var LIndex : Integer;
+var
LRaw : TRawBytes;
- LStartNameString : String;
+ {$IFDEF USE_ABSTRACTMEM}
+ Laninfo : TAccountNameInfo;
+ {$ELSE}
+ LIndex : Integer;
+ {$ENDIF}
begin
ARawList.Clear;
StartThreadSafe;
try
{$IFDEF USE_ABSTRACTMEM}
- if FPCAbstractMem.AccountsNames.FindByName(AStartName.ToString,LIndex) then begin
- LRaw.FromString(FPCAbstractMem.AccountsNames.Item[LIndex].accountName);
- ARawList.Add( LRaw, FPCAbstractMem.AccountsNames.Item[LIndex].accountNumber );
- inc(LIndex);
- end;
- LStartNameString := AStartName.ToString;
- while (LIndexARawList.Count)) // AMax <=0 inifinte results
- do begin
- LRaw.FromString( FPCAbstractMem.AccountsNames.Item[LIndex].accountName );
- ARawList.Add( LRaw, FPCAbstractMem.AccountsNames.Item[LIndex].accountNumber );
- inc(LIndex);
+ FPCAbstractMem.AccountsNames.FindByName(AStartName.ToString,Laninfo);
+ while (Laninfo.accountName.StartsWith(AStartName.ToString))
+ and ((AMax<=0) or (AMax>ARawList.Count)) do begin
+ LRaw.FromString(Laninfo.accountName);
+ ARawList.Add( LRaw, Laninfo.accountNumber );
+ if not FPCAbstractMem.AccountsNames.FindDataSuccessor(Laninfo,Laninfo) then Break;
end;
{$ELSE}
if FOrderedByName.Find(AStartName,LIndex) then begin
@@ -4680,6 +4864,8 @@ procedure TPCSafeBox.UpdateAccount(account_number : Cardinal; const newAccountIn
blockAccount : TBlockAccount;
{$IFnDEF USE_ABSTRACTMEM}
Pblock : PBlockAccount;
+ {$ELSE}
+ Laninfo : TAccountNameInfo;
{$ENDIF}
begin
iBlock := account_number DIV CT_AccountsPerBlock;
@@ -4693,6 +4879,16 @@ procedure TPCSafeBox.UpdateAccount(account_number : Cardinal; const newAccountIn
end else begin
Pblock := FBlockAccountsList.Items[iBlock];
end;
+ FAccountsOrderedByUpdatedBlock.Update(
+ account_number,
+ blockAccount.accounts[iAccount].updated_on_block_active_mode,
+ newUpdated_block_active_mode
+ );
+ FAccountsOrderedBySalePrice.UpdateAccountBySalePrice(
+ account_number,
+ blockAccount.accounts[iAccount].accountInfo,
+ newAccountInfo
+ );
{$ENDIF}
if (NOT TAccountComp.EqualAccountKeys(blockAccount.accounts[iAccount].accountInfo.accountKey,newAccountInfo.accountKey)) then begin
@@ -4723,16 +4919,15 @@ procedure TPCSafeBox.UpdateAccount(account_number : Cardinal; const newAccountIn
If Length(blockAccount.accounts[iAccount].name)>0 then begin
{$IFDEF USE_ABSTRACTMEM}
- i := FPCAbstractMem.AccountsNames.IndexOf(blockAccount.accounts[iAccount].name.ToString);
- if i<0 then begin
+ if Not FPCAbstractMem.AccountsNames.FindByName(blockAccount.accounts[iAccount].name.ToString,Laninfo) then begin
If (Not Assigned(FPreviousSafeBox)) then begin
TLog.NewLog(ltError,ClassName,'ERROR DEV 20170606-1 Name "'+blockAccount.accounts[iAccount].name.ToPrintable+'" not found for delete on account '+IntToStr(account_number));
end;
end else begin
- If (FPCAbstractMem.AccountsNames.Item[i].accountNumber<>account_number) then begin
- TLog.NewLog(ltError,ClassName,'ERROR DEV 20170606-3 Name "'+blockAccount.accounts[iAccount].name.ToPrintable+'" not found for delete at suposed account '+IntToStr(account_number)+' found at '+IntToStr(FPCAbstractMem.AccountsNames.Item[i].accountNumber)+' '+FPCAbstractMem.AccountsNames.Item[i].accountName);
+ If (Laninfo.accountNumber<>account_number) then begin
+ TLog.NewLog(ltError,ClassName,'ERROR DEV 20170606-3 Name "'+blockAccount.accounts[iAccount].name.ToPrintable+'" not found for delete at suposed account '+IntToStr(account_number)+' found at '+IntToStr(Laninfo.accountNumber)+' '+Laninfo.accountName);
end;
- FPCAbstractMem.AccountsNames.Delete(i);
+ FPCAbstractMem.AccountsNames.DeleteData(Laninfo);
end;
{$ELSE}
i := FOrderedByName.IndexOf(blockAccount.accounts[iAccount].name);
@@ -4753,11 +4948,11 @@ procedure TPCSafeBox.UpdateAccount(account_number : Cardinal; const newAccountIn
If (iDeleted<0) then begin
If (iAdded<0) then begin
- {$IFDEF HIGHLOG}TLog.NewLog(ltdebug,ClassName,Format('Deleted from PREVIOUS snapshot name:%s at account:%d',[blockAccount.accounts[iAccount].name,account_number]));{$ENDIF}
+ {$IFDEF HIGHLOG}TLog.NewLog(ltdebug,ClassName,Format('Deleted from PREVIOUS snapshot name:%s at account:%d',[blockAccount.accounts[iAccount].name.ToPrintable,account_number]));{$ENDIF}
FDeletedNamesSincePreviousSafebox.Add(blockAccount.accounts[iAccount].name,account_number); // Very important to store account_number in order to restore a snapshot!
end else begin
// Was added, so delete from added
- {$IFDEF HIGHLOG}TLog.NewLog(ltdebug,ClassName,Format('Deleted from current snapshot name:%s at account:%d',[blockAccount.accounts[iAccount].name,account_number]));{$ENDIF}
+ {$IFDEF HIGHLOG}TLog.NewLog(ltdebug,ClassName,Format('Deleted from current snapshot name:%s at account:%d',[blockAccount.accounts[iAccount].name.ToPrintable,account_number]));{$ENDIF}
FAddedNamesSincePreviousSafebox.Delete(iAdded);
end;
end else begin
@@ -4770,9 +4965,11 @@ procedure TPCSafeBox.UpdateAccount(account_number : Cardinal; const newAccountIn
blockAccount.accounts[iAccount].name:=newName;
If Length(blockAccount.accounts[iAccount].name)>0 then begin
{$IFDEF USE_ABSTRACTMEM}
- i := FPCAbstractMem.AccountsNames.IndexOf(blockAccount.accounts[iAccount].name.ToString);
- if i>=0 then TLog.NewLog(ltError,ClassName,'ERROR DEV 20170606-2 New Name "'+blockAccount.accounts[iAccount].name.ToPrintable+'" for account '+IntToStr(account_number)+' found at account '+IntToStr(FPCAbstractMem.AccountsNames.Item[i].accountNumber));
- FPCAbstractMem.AccountsNames.Add(blockAccount.accounts[iAccount].name.ToString,account_number);
+ if FPCAbstractMem.AccountsNames.FindByName(blockAccount.accounts[iAccount].name.ToString,Laninfo) then begin
+ TLog.NewLog(ltError,ClassName,'ERROR DEV 20170606-2 New Name "'+blockAccount.accounts[iAccount].name.ToPrintable+'" for account '+IntToStr(account_number)+' found at account '+IntToStr(Laninfo.accountNumber));
+ FPCAbstractMem.AccountsNames.DeleteData(Laninfo);
+ end;
+ FPCAbstractMem.AccountsNames.AddNameAndNumber(blockAccount.accounts[iAccount].name.ToString,account_number);
{$ELSE}
i := FOrderedByName.IndexOf(blockAccount.accounts[iAccount].name);
if i>=0 then TLog.NewLog(ltError,ClassName,'ERROR DEV 20170606-2 New Name "'+blockAccount.accounts[iAccount].name.ToPrintable+'" for account '+IntToStr(account_number)+' found at account '+IntToStr(FOrderedByName.GetTag(i)));
@@ -4786,17 +4983,17 @@ procedure TPCSafeBox.UpdateAccount(account_number : Cardinal; const newAccountIn
If (iDeleted>=0) Then begin
if (FDeletedNamesSincePreviousSafebox.GetTag(iDeleted)=account_number) then begin
// Is restoring to initial position, delete from deleted
- {$IFDEF HIGHLOG}TLog.NewLog(ltdebug,ClassName,Format('Adding equal to PREVIOUS (DELETING FROM DELETED) snapshot name:%s at account:%d',[blockAccount.accounts[iAccount].name,account_number]));{$ENDIF}
+ {$IFDEF HIGHLOG}TLog.NewLog(ltdebug,ClassName,Format('Adding equal to PREVIOUS (DELETING FROM DELETED) snapshot name:%s at account:%d',[blockAccount.accounts[iAccount].name.ToPrintable,account_number]));{$ENDIF}
FDeletedNamesSincePreviousSafebox.Delete(iDeleted);
if iAdded>=0 then FAddedNamesSincePreviousSafebox.Remove(blockAccount.accounts[iAccount].name);
end else begin
// Was deleted, but now adding to a new account
- {$IFDEF HIGHLOG}TLog.NewLog(ltdebug,ClassName,Format('Adding again name:%s to new account account:%d',[blockAccount.accounts[iAccount].name,account_number]));{$ENDIF}
+ {$IFDEF HIGHLOG}TLog.NewLog(ltdebug,ClassName,Format('Adding again name:%s to new account account:%d',[blockAccount.accounts[iAccount].name.ToPrintable,account_number]));{$ENDIF}
FAddedNamesSincePreviousSafebox.Add(blockAccount.accounts[iAccount].name,account_number);
end;
end else begin
// Was not deleted, Add it
- {$IFDEF HIGHLOG}TLog.NewLog(ltdebug,ClassName,Format('Adding first time at this snapshot name:%s at account:%d',[blockAccount.accounts[iAccount].name,account_number]));{$ENDIF}
+ {$IFDEF HIGHLOG}TLog.NewLog(ltdebug,ClassName,Format('Adding first time at this snapshot name:%s at account:%d',[blockAccount.accounts[iAccount].name.ToPrintable,account_number]));{$ENDIF}
FAddedNamesSincePreviousSafebox.Add(blockAccount.accounts[iAccount].name,account_number);
end;
end;
@@ -5079,6 +5276,15 @@ function TPCSafeBoxTransaction.Commit(const operationBlock: TOperationBlock;
end;
end;
end;
+ if (FFreezedAccounts.FCurrentProtocol0 then begin
- If Not TPCSafeBox.ValidAccountName(newName,errors) then begin
+ If Not TPascalCoinProtocol.IsValidAccountName(FreezedSafeBox.CurrentProtocol,newName,errors) then begin
errors := 'Invalid account name "'+newName.ToPrintable+'" length:'+IntToStr(length(newName))+': '+errors;
Exit;
end;
diff --git a/src/core/UBaseTypes.pas b/src/core/UBaseTypes.pas
index f2e8020dd..2b3fe1398 100644
--- a/src/core/UBaseTypes.pas
+++ b/src/core/UBaseTypes.pas
@@ -98,13 +98,16 @@ TRawBytesHelper = record helper for TRawBytes
function Replace(startPos : Integer; const buffer : TBytes) : Integer; overload;
function Replace(startPos : Integer; const buffer; bufferSize : Integer) : Integer; overload;
property DefaultIncrement : Integer read FDefaultIncrement write SetDefaultIncrement;
- function Compare(ABytesBuffer : TBytesBuffer) : Integer;
+ function Compare(ABytesBuffer : TBytesBuffer) : Integer; overload;
+ function Compare(AStream : TStream) : Integer; overload;
procedure SetLength(ANewLength : Integer);
function Memory : Pointer;
function MemoryLength : Integer;
procedure Clear;
procedure CopyFrom(ABytesBuffer : TBytesBuffer);
function Capture(AStartPos, ALength : Integer) : TBytes;
+ procedure SaveToStream(AStream : TStream);
+ procedure LoadFromStream(AStream : TStream);
end;
@@ -215,7 +218,8 @@ function TRawBytesHelper.FromSerialized(const ASerialized: TBytes; ACheckLength
Move(ASerialized[0],Lsize,2);
if (2 + Lsize > Length(ASerialized)) then Exit(False);
SetLength(Self,Lsize);
- Move(ASerialized[2],Self[0],Lsize);
+ if Lsize>0 then
+ Move(ASerialized[2],Self[0],Lsize);
Result := True;
end;
@@ -624,10 +628,15 @@ procedure TBytesBuffer.IncreaseSize(newSize: Integer);
end;
end;
+procedure TBytesBuffer.SaveToStream(AStream: TStream);
+begin
+ AStream.Write(FBytes[0],Self.Length);
+end;
+
procedure TBytesBuffer.SetDefaultIncrement(AValue: Integer);
begin
if AValue<=0 then FDefaultIncrement:=1024
- else if AValue>(1024*1024) then FDefaultIncrement := 1024*1024
+ else if AValue>(100*1024*1024) then FDefaultIncrement := (100*1024*1024)
else FDefaultIncrement:=AValue;
end;
@@ -690,6 +699,18 @@ function TBytesBuffer.Compare(ABytesBuffer: TBytesBuffer): Integer;
end;
end;
+function TBytesBuffer.Compare(AStream: TStream): Integer;
+var Lbb : TBytesBuffer;
+begin
+ Lbb := TBytesBuffer.Create(DefaultIncrement);
+ try
+ Lbb.LoadFromStream(AStream);
+ Result := Compare(Lbb);
+ finally
+ Lbb.Free;
+ end;
+end;
+
procedure TBytesBuffer.CopyFrom(ABytesBuffer: TBytesBuffer);
begin
System.SetLength(FBytes,System.Length(ABytesBuffer.FBytes));
@@ -725,6 +746,14 @@ function TBytesBuffer.Length: Integer;
Result := FUsedBytes;
end;
+procedure TBytesBuffer.LoadFromStream(AStream: TStream);
+begin
+ AStream.Position := 0;
+ IncreaseSize(Self.Length + AStream.Size);
+ AStream.Read(FBytes[FUsedBytes],AStream.Size);
+ SetLength(Self.Length + AStream.Size);
+end;
+
function TBytesBuffer.Memory: Pointer;
begin
Result := addr(FBytes[0]);
diff --git a/src/core/UBlockChain.pas b/src/core/UBlockChain.pas
index be1d1ce4a..65da5bd76 100644
--- a/src/core/UBlockChain.pas
+++ b/src/core/UBlockChain.pas
@@ -25,10 +25,10 @@
interface
uses
- Classes, UCrypto, UAccounts, ULog, UThread, SyncObjs, UBaseTypes, SysUtils,
+ Classes,{$IFnDEF FPC}Windows,{$ENDIF}UCrypto, UAccounts, ULog, UThread, SyncObjs, UBaseTypes, SysUtils,
{$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF},
{$IFDEF USE_ABSTRACTMEM}UPCAbstractMem,{$ENDIF}
- UPCDataTypes, UChunk;
+ UPCDataTypes, UChunk, UOrderedList;
{
@@ -113,6 +113,7 @@ interface
}
Type
+ TSearchOpHashResult = (OpHash_found, OpHash_invalid_params, OpHash_block_not_found);
// Moved from UOpTransaction to here
TOpChangeAccountInfoType = (public_key, account_name, account_type, list_for_public_sale, list_for_private_sale, delist, account_data, list_for_account_swap, list_for_coin_swap );
TOpChangeAccountInfoTypes = Set of TOpChangeAccountInfoType;
@@ -188,6 +189,7 @@ TMultiOpData = record
Balance : Int64;
OriginalPayload : TOperationPayload;
PrintablePayload : String;
+ DecodedEPasaPayload : String;
OperationHash : TRawBytes;
OperationHash_OLD : TRawBytes; // Will include old oeration hash value
errors : String;
@@ -203,19 +205,8 @@ TMultiOpData = record
TPCOperation = Class;
TPCOperationClass = Class of TPCOperation;
- TOperationsResumeList = Class
- private
- FList : TPCThreadList;
- function GetOperationResume(index: Integer): TOperationResume;
- public
- Constructor Create;
- Destructor Destroy; override;
- Procedure Add(Const OperationResume : TOperationResume);
- Function Count : Integer;
- Procedure Delete(index : Integer);
- Procedure Clear;
- Property OperationResume[index : Integer] : TOperationResume read GetOperationResume; default;
- End;
+
+ TOperationsResumeList = TList;
TOpReference = UInt64;
TOpReferenceArray = Array of TopReference;
@@ -223,6 +214,10 @@ TMultiOpData = record
{ TPCOperation }
TPCOperation = Class
+ private
+ FResendOnBlock: Integer;
+ FDiscoveredOnBlock: Integer;
+ FResendCount: Integer;
Protected
FProtocolVersion : Word;
FHasValidSignature : Boolean;
@@ -243,7 +238,7 @@ TMultiOpData = record
property ProtocolVersion : Word read FProtocolVersion;
function GetBufferForOpHash(UseProtocolV2 : Boolean): TRawBytes; virtual;
function DoOperation(AccountPreviousUpdatedBlock : TAccountPreviousBlockInfo; AccountTransaction : TPCSafeBoxTransaction; var errors: String): Boolean; virtual; abstract;
- procedure AffectedAccounts(list : TList); virtual; abstract;
+ procedure AffectedAccounts(list : TOrderedList); virtual; abstract;
class function OpType: Byte; virtual; abstract;
Class Function OperationToOperationResume(Block : Cardinal; Operation : TPCOperation; getInfoForAllAccounts : Boolean; Affected_account_number : Cardinal; var OperationResume : TOperationResume) : Boolean; virtual;
Function GetDigestToSign : TRawBytes; virtual; abstract;
@@ -274,6 +269,7 @@ TMultiOpData = record
class function OperationHashAsHexa(const operationHash : TRawBytes) : String;
class function GetOpReferenceAccount(const opReference : TOpReference) : Cardinal;
class function GetOpReferenceN_Operation(const opReference : TOpReference) : Cardinal;
+ class function CreateOperationFromStream(AStream : TStream; var AOperation : TPCOperation) : Boolean;
function Sha256 : TRawBytes;
function RipeMD160 : TRawBytes;
function GetOpReference : TOpReference;
@@ -284,6 +280,9 @@ TMultiOpData = record
class function GetOperationFromStreamData(AUseV5EncodeStyle : Boolean; ACurrentProtocol: word; StreamData : TBytes) : TPCOperation;
//
function IsValidSignatureBasedOnCurrentSafeboxState(ASafeBoxTransaction : TPCSafeBoxTransaction) : Boolean; virtual; abstract;
+ property DiscoveredOnBlock : Integer read FDiscoveredOnBlock write FDiscoveredOnBlock;
+ property ResendOnBlock : Integer read FResendOnBlock write FResendOnBlock;
+ property ResendCount : Integer read FResendCount write FResendCount;
End;
TPCOperationStorage = Record
@@ -336,6 +335,7 @@ TMultiOpData = record
FTotalAmount : Int64;
FTotalFee : Int64;
FMax0feeOperationsBySigner : Integer;
+ FHasOpRecoverOperations : Boolean;
function InternalCanAddOperationToHashTree(lockedThreadList : TList; op : TPCOperation) : Boolean;
function InternalAddOperationToHashTree(list : TList; op : TPCOperation; CalcNewHashTree : Boolean) : Boolean;
Function FindOrderedByOpReference(lockedThreadList : TList; const Value: TOpReference; var Index: Integer): Boolean;
@@ -357,7 +357,8 @@ TMultiOpData = record
Property TotalAmount : Int64 read FTotalAmount;
Property TotalFee : Int64 read FTotalFee;
function SaveOperationsHashTreeToStream(AStream: TStream; ASaveToStorage : Boolean): Boolean;
- function LoadOperationsHashTreeFromStream(AStream: TStream; ALoadingFromStorage : Boolean; ASetOperationsToProtocolVersion : Word; ALoadFromStorageVersion : Word; APreviousUpdatedBlocks : TAccountPreviousBlockInfo; var AErrors : String): Boolean;
+ function LoadOperationsHashTreeFromStream(AStream: TStream; ALoadingFromStorage : Boolean; ASetOperationsToProtocolVersion : Word; ALoadFromStorageVersion : Word; APreviousUpdatedBlocks : TAccountPreviousBlockInfo; var AErrors : String): Boolean; overload;
+ function LoadOperationsHashTreeFromStream(AStream: TStream; ALoadingFromStorage : Boolean; ASetOperationsToProtocolVersion : Word; ALoadFromStorageVersion : Word; APreviousUpdatedBlocks : TAccountPreviousBlockInfo; AAllow0FeeOperations : Boolean; var AOperationsCount, AProcessedCount : Integer; var AErrors : String): Boolean; overload;
function IndexOfOperation(op : TPCOperation) : Integer;
function CountOperationsBySameSignerWithoutFee(account_number : Cardinal) : Integer;
Procedure Delete(index : Integer);
@@ -366,7 +367,7 @@ TMultiOpData = record
Property OnChanged : TNotifyEvent read FOnChanged write FOnChanged;
Property Max0feeOperationsBySigner : Integer Read FMax0feeOperationsBySigner write SetMax0feeOperationsBySigner;
procedure MarkVerifiedECDSASignatures(operationsHashTreeToMark : TOperationsHashTree);
-
+ Property HasOpRecoverOperations : Boolean read FHasOpRecoverOperations;
// Will add all operations of the HashTree to then end of AList without removing previous objects
function GetOperationsList(AList : TList; AAddOnlyOperationsWithoutNotVerifiedSignature : Boolean) : Integer;
End;
@@ -417,8 +418,10 @@ TMultiOpData = record
Procedure Clear(DeleteOperations : Boolean);
Function Count: Integer;
Property OperationBlock: TOperationBlock read FOperationBlock;
+ procedure SetOperationBlock(const ANewValues : TOperationBlock); // For testing purposes only
Class Function OperationBlockToText(const OperationBlock: TOperationBlock) : String;
Class Function SaveOperationBlockToStream(Const OperationBlock: TOperationBlock; Stream: TStream) : Boolean;
+ class Function LoadOperationBlockFromStream(AStream : TStream; var Asoob : Byte; var AOperationBlock : TOperationBlock) : Boolean;
Property AccountKey: TAccountKey read GetAccountKey write SetAccountKey;
Property nonce: Cardinal read GetnOnce write SetnOnce;
Property timestamp: Cardinal read Gettimestamp write Settimestamp;
@@ -431,6 +434,7 @@ TMultiOpData = record
function LoadBlockFromStream(Stream: TStream; var errors: String): Boolean;
//
Function GetMinerRewardPseudoOperation : TOperationResume;
+ Function AddMinerRecover(LRecoverAccounts: TAccountList; const ANewAccountKey : TAccountKey) : Boolean;
Function ValidateOperationBlock(var errors : String) : Boolean;
Property IsOnlyOperationBlock : Boolean read FIsOnlyOperationBlock;
Procedure Lock;
@@ -481,50 +485,54 @@ TMultiOpData = record
TStorage = Class(TComponent)
private
- FOrphan: TOrphan;
FBank : TPCBank;
FReadOnly: Boolean;
+ FPendingBufferOperationsStream : TFileStream;
procedure SetBank(const Value: TPCBank);
+ Function GetPendingBufferOperationsStream : TFileStream;
protected
FIsMovingBlockchain : Boolean;
- procedure SetOrphan(const Value: TOrphan); virtual;
+ FStorageFilename: String;
procedure SetReadOnly(const Value: Boolean); virtual;
Function DoLoadBlockChain(Operations : TPCOperationsComp; Block : Cardinal) : Boolean; virtual; abstract;
Function DoSaveBlockChain(Operations : TPCOperationsComp) : Boolean; virtual; abstract;
- Function DoMoveBlockChain(StartBlock : Cardinal; Const DestOrphan : TOrphan; DestStorage : TStorage) : Boolean; virtual; abstract;
- Function DoSaveBank : Boolean; virtual; abstract;
- Function DoRestoreBank(max_block : Int64; restoreProgressNotify : TProgressNotify) : Boolean; virtual; abstract;
+ Function DoMoveBlockChain(StartBlock : Cardinal; Const DestOrphan : TOrphan) : Boolean; virtual; abstract;
Procedure DoDeleteBlockChainBlocks(StartingDeleteBlock : Cardinal); virtual; abstract;
Function DoBlockExists(Block : Cardinal) : Boolean; virtual; abstract;
function GetFirstBlockNumber: Int64; virtual; abstract;
function GetLastBlockNumber: Int64; virtual; abstract;
function DoInitialize:Boolean; virtual; abstract;
- Function DoOpenSafeBoxCheckpoint(blockCount : Cardinal) : TCheckPointStruct; virtual; abstract;
Procedure DoEraseStorage; virtual; abstract;
- Procedure DoSavePendingBufferOperations(OperationsHashTree : TOperationsHashTree); virtual; abstract;
- Procedure DoLoadPendingBufferOperations(OperationsHashTree : TOperationsHashTree); virtual; abstract;
+ Procedure DoSavePendingBufferOperations(OperationsHashTree : TOperationsHashTree); virtual;
+ Procedure DoLoadPendingBufferOperations(OperationsHashTree : TOperationsHashTree); virtual;
+ Function DoGetBlockInformation(const ABlock : Integer; var AOperationBlock : TOperationBlock; var AOperationsCount : Integer; var AVolume : Int64) : Boolean; virtual;
+ Function DoGetBlockOperations(ABlock, AOpBlockStartIndex, AMaxOperations : Integer; var AOperationBlock : TOperationBlock; var AOperationsCount : Integer; var AVolume : Int64; const AOperationsResumeList:TOperationsResumeList) : Boolean; virtual;
+ Function DoGetAccountOperations(AAccount : Integer; AMaxDepth, AStartOperation, AMaxOperations, ASearchBackwardsStartingAtBlock: Integer; const AOperationsResumeList:TOperationsResumeList): Boolean; virtual;
+ function DoFindOperation(const AOpHash : TBytes; var AOperationResume : TOperationResume) : TSearchOpHashResult; virtual;
public
Function LoadBlockChainBlock(Operations : TPCOperationsComp; Block : Cardinal) : Boolean;
Function SaveBlockChainBlock(Operations : TPCOperationsComp) : Boolean;
Function MoveBlockChainBlocks(StartBlock : Cardinal; Const DestOrphan : TOrphan; DestStorage : TStorage) : Boolean;
Procedure DeleteBlockChainBlocks(StartingDeleteBlock : Cardinal);
- Function SaveBank(forceSave : Boolean) : Boolean;
- Function RestoreBank(max_block : Int64; restoreProgressNotify : TProgressNotify = Nil) : Boolean;
Constructor Create(AOwner : TComponent); Override;
- Property Orphan : TOrphan read FOrphan write SetOrphan;
+ Destructor Destroy; override;
Property ReadOnly : Boolean read FReadOnly write SetReadOnly;
Property Bank : TPCBank read FBank write SetBank;
Procedure CopyConfiguration(Const CopyFrom : TStorage); virtual;
Property FirstBlock : Int64 read GetFirstBlockNumber;
Property LastBlock : Int64 read GetLastBlockNumber;
Function Initialize : Boolean;
- Function OpenSafeBoxCheckpoint(blockCount : Cardinal) : TCheckPointStruct;
- Function HasUpgradedToVersion2 : Boolean; virtual; abstract;
- Procedure CleanupVersion1Data; virtual; abstract;
Procedure EraseStorage; // Erase Blockchain storage
Procedure SavePendingBufferOperations(OperationsHashTree : TOperationsHashTree);
Procedure LoadPendingBufferOperations(OperationsHashTree : TOperationsHashTree);
Function BlockExists(Block : Cardinal) : Boolean;
+
+ function Orphan : String;
+ Function GetBlockInformation(ABlock : Integer; var AOperationBlock : TOperationBlock; var AOperationsCount : Integer; var AVolume : Int64) : Boolean;
+ Function GetBlockOperations(ABlock, AOpBlockStartIndex, AMaxOperations : Integer; var AOperationBlock : TOperationBlock; var AOperationsCount : Integer; var AVolume : Int64; const AOperationsResumeList:TOperationsResumeList) : Boolean;
+ Function GetAccountOperations(AAccount : Integer; AMaxDepth, AStartOperation, AMaxOperations, ASearchBackwardsStartingAtBlock: Integer; const AOperationsResumeList:TOperationsResumeList): Boolean;
+ function FindOperation(const AOpHash : TBytes; var AOperationResume : TOperationResume) : TSearchOpHashResult;
+ property StorageFilename : String read FStorageFilename write FStorageFilename;
End;
TStorageClass = Class of TStorage;
@@ -538,13 +546,14 @@ TMultiOpData = record
FLastBlockCache : TPCOperationsComp;
FLastOperationBlock: TOperationBlock;
FIsRestoringFromFile: Boolean;
- FUpgradingToV2: Boolean;
FOnLog: TPCBankLog;
FBankLock: TPCCriticalSection;
FNotifyList : TList;
FStorageClass: TStorageClass;
+ FOrphan: TOrphan;
function GetStorage: TStorage;
procedure SetStorageClass(const Value: TStorageClass);
+ Function DoSaveBank : Boolean;
public
Constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
@@ -569,12 +578,21 @@ TMultiOpData = record
Property StorageClass : TStorageClass read FStorageClass write SetStorageClass;
Function IsReady(Var CurrentProcess : String) : Boolean;
Property LastBlockFound : TPCOperationsComp read FLastBlockCache;
- Property UpgradingToV2 : Boolean read FUpgradingToV2;
+ Function OpenSafeBoxCheckpoint(ABlockCount : Cardinal) : TCheckPointStruct;
+ Class Function GetSafeboxCheckpointingFileName(Const ABaseDataFolder : String; ABlock : Cardinal) : String;
+ Class Function GetStorageFolder(Const AOrphan : String) : String;
+ Function RestoreBank(AMax_block : Int64; AOrphan : String; ARestoreProgressNotify : TProgressNotify) : Boolean;
+ Function LoadBankFileInfo(Const AFilename : String; var ASafeBoxHeader : TPCSafeBoxHeader) : Boolean;
+ Property Orphan : TOrphan read FOrphan write FOrphan;
+ Function SaveBank(forceSave : Boolean) : Boolean;
+ Property IsRestoringFromFile : Boolean read FIsRestoringFromFile;
End;
Const
+ CT_Safebox_Extension = {$IFDEF USE_ABSTRACTMEM}'.am_safebox'{$ELSE}'.safebox'{$ENDIF};
+
CT_TOperationPayload_NUL : TOperationPayload = (payload_type:0;payload_raw:Nil);
- CT_TOperationResume_NUL : TOperationResume = (valid:false;Block:0;NOpInsideBlock:-1;OpType:0;OpSubtype:0;time:0;AffectedAccount:0;SignerAccount:-1;n_operation:0;DestAccount:-1;SellerAccount:-1;newKey:(EC_OpenSSL_NID:0;x:Nil;y:Nil);OperationTxt:'';Amount:0;Fee:0;Balance:0;OriginalPayload:(payload_type:0;payload_raw:nil);PrintablePayload:'';OperationHash:Nil;OperationHash_OLD:Nil;errors:'';isMultiOperation:False;Senders:Nil;Receivers:Nil;changers:Nil);
+ CT_TOperationResume_NUL : TOperationResume = (valid:false;Block:0;NOpInsideBlock:-1;OpType:0;OpSubtype:0;time:0;AffectedAccount:0;SignerAccount:-1;n_operation:0;DestAccount:-1;SellerAccount:-1;newKey:(EC_OpenSSL_NID:0;x:Nil;y:Nil);OperationTxt:'';Amount:0;Fee:0;Balance:0;OriginalPayload:(payload_type:0;payload_raw:nil);PrintablePayload:'';DecodedEPasaPayload:'';OperationHash:Nil;OperationHash_OLD:Nil;errors:'';isMultiOperation:False;Senders:Nil;Receivers:Nil;changers:Nil);
CT_TMultiOpSender_NUL : TMultiOpSender = (Account:0;Amount:0;N_Operation:0;Payload:(payload_type:0;payload_raw:Nil);Signature:(r:Nil;s:Nil));
CT_TMultiOpReceiver_NUL : TMultiOpReceiver = (Account:0;Amount:0;Payload:(payload_type:0;payload_raw:Nil));
CT_TMultiOpChangeInfo_NUL : TMultiOpChangeInfo = (Account:0;N_Operation:0;Changes_type:[];New_Accountkey:(EC_OpenSSL_NID:0;x:Nil;y:Nil);New_Name:Nil;New_Type:0;New_Data:Nil;Seller_Account:-1;Account_Price:-1;Locked_Until_Block:0;
@@ -588,7 +606,9 @@ implementation
Variants,
UTime, UConst, UOpTransaction, UPCOrderedLists,
UPCOperationsSignatureValidator,
- UPCOperationsBlockValidator;
+ UPCOperationsBlockValidator,
+ UAbstractMemBlockchainStorage,
+ UNode;
{ TPCOperationsStorage }
@@ -896,7 +916,6 @@ constructor TPCBank.Create(AOwner: TComponent);
FNotifyList := TList.Create;
FLastBlockCache := TPCOperationsComp.Create(Nil);
FIsRestoringFromFile:=False;
- FUpgradingToV2:=False;
Clear;
end;
@@ -945,7 +964,6 @@ procedure TPCBank.DiskRestoreFromOperations(max_block : Int64; restoreProgressNo
LStartProcessTC := tc;
TPCThread.ProtectEnterCriticalSection(Self,FBankLock);
try
- FUpgradingToV2 := NOT Storage.HasUpgradedToVersion2;
FIsRestoringFromFile := true;
try
Clear;
@@ -953,7 +971,7 @@ procedure TPCBank.DiskRestoreFromOperations(max_block : Int64; restoreProgressNo
If (max_block0) And (SafeBox.CurrentProtocol=CT_PROTOCOL_1) then begin
if Not Storage.LoadBlockChainBlock(FLastBlockCache,BlocksCount-1) then begin
@@ -969,14 +987,14 @@ procedure TPCBank.DiskRestoreFromOperations(max_block : Int64; restoreProgressNo
FLastOperationBlock.initial_safe_box_hash := TPCSafeBox.InitialSafeboxHash; // Genesis hash
end;
- NewLog(Nil, ltinfo,'Start restoring from disk operations (Max '+inttostr(max_block)+') BlockCount: '+inttostr(BlocksCount)+' Orphan: ' +Storage.Orphan);
+ NewLog(Nil, ltinfo,'Start restoring from disk operations (Max '+inttostr(max_block)+') BlockCount: '+inttostr(BlocksCount)+' Orphan: ' +Orphan);
LBlocks := TList.Create;
try
LProgressBlock := 0;
LProgressEndBlock := Storage.LastBlock - BlocksCount;
while ((BlocksCount<=max_block)) do begin
i := BlocksCount;
- j := i + 99;
+ j := i + 999;
// Load a batch of TPCOperationsComp;
try
LOpsInBlocks := 0;
@@ -1017,9 +1035,8 @@ procedure TPCBank.DiskRestoreFromOperations(max_block : Int64; restoreProgressNo
Exit;
end else begin
// To prevent continuous saving...
- if ((BlocksCount+(CT_BankToDiskEveryNBlocks*2)) >= Storage.LastBlock ) or
- ((BlocksCount MOD (CT_BankToDiskEveryNBlocks*10))=0) then begin
- Storage.SaveBank(False);
+ if ((BlocksCount MOD (CT_BankToDiskEveryNBlocks*10))=0) then begin
+ SaveBank(False);
end;
if (Assigned(restoreProgressNotify)) And (TPlatform.GetElapsedMilliseconds(tc)>1000) then begin
tc := TPlatform.GetTickCount;
@@ -1039,24 +1056,94 @@ procedure TPCBank.DiskRestoreFromOperations(max_block : Int64; restoreProgressNo
finally
LBlocks.Free;
- if FUpgradingToV2 then Storage.CleanupVersion1Data;
- NewLog(Nil, ltinfo,'End restoring from disk operations (Max '+inttostr(max_block)+') Orphan: ' + Storage.Orphan+' Restored '+Inttostr(BlocksCount)+' blocks in '+IntToStr(TPlatform.GetElapsedMilliseconds(LStartProcessTC))+' milliseconds');
+ NewLog(Nil, ltinfo,'End restoring from disk operations (Max '+inttostr(max_block)+') Orphan: ' + Orphan+' Restored '+Inttostr(BlocksCount)+' blocks in '+IntToStr(TPlatform.GetElapsedMilliseconds(LStartProcessTC))+' milliseconds');
end;
finally
FIsRestoringFromFile := False;
- FUpgradingToV2 := false;
for i := 0 to FNotifyList.Count - 1 do begin
TPCBankNotify(FNotifyList.Items[i]).NotifyNewBlock;
end;
end;
-
-
+ {$IFDEF USE_ABSTRACTMEM}
+ SafeBox.PCAbstractMem.FlushCache;
+ {$ENDIF}
finally
FBankLock.Release;
end;
end;
+Procedure DoCopyFile(sourcefn,destfn : AnsiString);
+var sourceFS, destFS : TFileStream;
+Begin
+ if Not FileExists(sourcefn) then Raise Exception.Create('Source file not found: '+sourcefn);
+ sourceFS := TFileStream.Create(sourcefn,fmOpenRead+fmShareDenyNone);
+ try
+ sourceFS.Position:=0;
+ destFS := TFileStream.Create(destfn,fmCreate+fmShareDenyWrite);
+ try
+ destFS.Size:=0;
+ destFS.CopyFrom(sourceFS,sourceFS.Size);
+ finally
+ destFS.Free;
+ end;
+ finally
+ sourceFS.Free;
+ end;
+end;
+
+function TPCBank.DoSaveBank: Boolean;
+var fs: TFileStream;
+ LBankfilename,Laux_newfilename: AnsiString;
+ ms : TMemoryStream;
+ LTC : TTickCount;
+begin
+ Result := true;
+ LBankfilename := GetSafeboxCheckpointingFileName(GetStorageFolder(Orphan),BlocksCount);
+ if (LBankfilename<>'') then begin
+ LTC := TPlatform.GetTickCount;
+ {$IFDEF USE_ABSTRACTMEM}
+ SafeBox.SaveCheckpointing(LBankfilename);
+ {$ELSE}
+ fs := TFileStream.Create(bankfilename,fmCreate);
+ try
+ fs.Size := 0;
+ fs.Position:=0;
+ if LowMemoryUsage then begin
+ Bank.SafeBox.SaveSafeBoxToAStream(fs,0,Bank.SafeBox.BlocksCount-1);
+ end else begin
+ ms := TMemoryStream.Create;
+ try
+ Bank.SafeBox.SaveSafeBoxToAStream(ms,0,Bank.SafeBox.BlocksCount-1);
+ ms.Position := 0;
+ fs.CopyFrom(ms,0);
+ finally
+ ms.Free;
+ end;
+ end;
+ finally
+ fs.Free;
+ end;
+ {$ENDIF}
+ TLog.NewLog(ltInfo,ClassName,Format('Saving Safebox blocks:%d file:%s in %.2n seconds',[BlocksCount,LBankfilename,TPlatform.GetElapsedMilliseconds(LTC)/1000]));
+ // Save a copy each 10000 blocks (aprox 1 month) only when not an orphan
+ if (Orphan='') And ((BlocksCount MOD (CT_BankToDiskEveryNBlocks*100))=0) then begin
+ Laux_newfilename := GetStorageFolder('') + PathDelim+'checkpoint_'+ inttostr(BlocksCount)+CT_Safebox_Extension;
+ try
+ {$IFDEF FPC}
+ DoCopyFile(LBankfilename,Laux_newfilename);
+ {$ELSE}
+ CopyFile(PWideChar(LBankfilename),PWideChar(Laux_newfilename),False);
+ {$ENDIF}
+ Except
+ On E:Exception do begin
+ TLog.NewLog(lterror,ClassName,'Exception copying extra safebox file '+Laux_newfilename+' ('+E.ClassName+'):'+E.Message);
+ end;
+ end;
+ end;
+ end;
+end;
+
procedure TPCBank.UpdateValuesFromSafebox;
Var aux : String;
i : Integer;
@@ -1177,6 +1264,21 @@ function TPCBank.GetTargetSecondsMedian(AFromBlock: Cardinal; ABackBlocks : Inte
end;
end;
+Const CT_SafeboxsToStore = 10;
+
+class function TPCBank.GetSafeboxCheckpointingFileName(
+ const ABaseDataFolder: String; ABlock: Cardinal): String;
+begin
+ Result := '';
+ If not ForceDirectories(ABaseDataFolder) then exit;
+ if TPCSafeBox.MustSafeBoxBeSaved(ABlock) then begin
+ // We will store checkpointing
+ Result := ABaseDataFolder + PathDelim+'checkpoint'+ inttostr((ABlock DIV CT_BankToDiskEveryNBlocks) MOD CT_SafeboxsToStore)+CT_Safebox_Extension;
+ end else begin
+ Result := ABaseDataFolder + PathDelim+'checkpoint_'+inttostr(ABlock)+CT_Safebox_Extension;
+ end;
+end;
+
function TPCBank.GetStorage: TStorage;
begin
if Not Assigned(FStorage) then begin
@@ -1187,18 +1289,34 @@ function TPCBank.GetStorage: TStorage;
Result := FStorage;
end;
+class function TPCBank.GetStorageFolder(const AOrphan: String): String;
+var Lbase : String;
+begin
+ Lbase := TNode.GetPascalCoinDataFolder + PathDelim + 'Data';
+ if Lbase = '' then raise Exception.Create('No Database Folder');
+ if AOrphan<>'' then Result := Lbase + PathDelim+AOrphan
+ else Result := Lbase;
+ if not ForceDirectories(Result) then raise Exception.Create('Cannot create storage folder: '+Result);
+end;
+
function TPCBank.IsReady(var CurrentProcess: String): Boolean;
begin
Result := false;
CurrentProcess := '';
if FIsRestoringFromFile then begin
- if FUpgradingToV2 then
- CurrentProcess := 'Migrating to version 2 format'
- else
- CurrentProcess := 'Restoring from file'
+ CurrentProcess := 'Restoring from file';
end else Result := true;
end;
+function TPCBank.LoadBankFileInfo(const AFilename: String;
+ var ASafeBoxHeader: TPCSafeBoxHeader): Boolean;
+begin
+ Result := false;
+ ASafeBoxHeader := CT_PCSafeBoxHeader_NUL;
+ If Not FileExists(AFilename) then exit;
+ Result := TPCSafeboxChunks.GetSafeboxHeaderFromFile(AFilename,ASafeBoxHeader);
+end;
+
function TPCBank.LoadBankFromChunks(AChunks : TPCSafeboxChunks;
checkSafeboxHash: TRawBytes; previousCheckedSafebox: TPCSafebox;
progressNotify: TProgressNotify; var errors: String): Boolean;
@@ -1249,12 +1367,20 @@ function TPCBank.LoadBankFromStream(Stream: TStream; useSecureLoad : Boolean; ch
Var LastReadBlock : TBlockAccount;
i : Integer;
auxSB : TPCSafeBox;
+ Lucoaml : boolean;
+ Lmmu : Integer;
begin
auxSB := Nil;
Try
If useSecureLoad then begin
// When on secure load will load Stream in a separate SafeBox, changing only real SafeBox if successfully
auxSB := TPCSafeBox.Create;
+ {$IFDEF USE_ABSTRACTMEM}
+ Lucoaml := Self.SafeBox.PCAbstractMem.UseCacheOnAbstractMemLists;
+ Lmmu := Self.SafeBox.PCAbstractMem.MaxMemUsage;
+ auxSB.PCAbstractMem.UseCacheOnAbstractMemLists := False;
+ auxSB.PCAbstractMem.MaxMemUsage := 100 * 1024 * 1024; // 100 Mb
+ {$ENDIF}
Result := auxSB.LoadSafeBoxFromStream(Stream,true,checkSafeboxHash,progressNotify,previousCheckedSafebox,LastReadBlock,errors);
If Not Result then Exit;
end;
@@ -1262,6 +1388,10 @@ function TPCBank.LoadBankFromStream(Stream: TStream; useSecureLoad : Boolean; ch
try
If Assigned(auxSB) then begin
SafeBox.CopyFrom(auxSB);
+ {$IFDEF USE_ABSTRACTMEM}
+ Self.SafeBox.PCAbstractMem.UseCacheOnAbstractMemLists := Lucoaml;
+ Self.SafeBox.PCAbstractMem.MaxMemUsage := Lmmu;
+ {$ENDIF}
end else begin
Result := SafeBox.LoadSafeBoxFromStream(Stream,False,checkSafeboxHash,progressNotify,previousCheckedSafebox,LastReadBlock,errors);
end;
@@ -1308,6 +1438,132 @@ procedure TPCBank.NewLog(Operations: TPCOperationsComp; Logtype: TLogType; const
FOnLog(Self, Operations, Logtype, Logtxt);
end;
+function TPCBank.OpenSafeBoxCheckpoint(ABlockCount: Cardinal): TCheckPointStruct;
+var fn : TFilename;
+ err : AnsiString;
+begin
+ Result := Nil;
+ fn := GetSafeboxCheckpointingFileName(GetStorageFolder(''),ABlockCount);
+ If (fn<>'') and (FileExists(fn)) then begin
+ {$IFDEF USE_ABSTRACTMEM}
+ Result := TPCAbstractMem.Create(fn,True);
+ {$ELSE}
+ Result := TFileStream.Create(fn,fmOpenRead+fmShareDenyWrite);
+ {$ENDIF}
+ end;
+ If Not Assigned(Result) then begin
+ err := 'Cannot load SafeBoxStream (block:'+IntToStr(ABlockCount)+') file:'+fn;
+ TLog.NewLog(ltError,ClassName,err);
+ end;
+end;
+
+function TPCBank.RestoreBank(AMax_block: Int64; AOrphan : String;
+ ARestoreProgressNotify: TProgressNotify): Boolean;
+var
+ sr: TSearchRec;
+ FileAttrs: Integer;
+ folder : AnsiString;
+ Lfilename,auxfn : AnsiString;
+ fs : TFileStream;
+ errors : String;
+ LBlockscount : Cardinal;
+ sbHeader, goodSbHeader : TPCSafeBoxHeader;
+ {$IFDEF USE_ABSTRACTMEM}
+ LTempBlocksCount : Integer;
+ LSafeboxFileName : String;
+ {$ELSE}
+ {$ENDIF}
+begin
+ FBankLock.Acquire;
+ Try
+ {$IFDEF USE_ABSTRACTMEM}
+ Lfilename := '';
+ LSafeboxFileName := GetStorageFolder(AOrphan)+PathDelim+'safebox'+CT_Safebox_Extension;
+ if TPCAbstractMem.AnalyzeFile(LSafeboxFileName,LTempBlocksCount) then begin
+ LBlockscount := LTempBlocksCount;
+ end else begin
+ LBlockscount := 0;
+ end;
+ //
+ FileAttrs := faArchive;
+ folder := GetStorageFolder(''); /// Without Orphan folder
+ if SysUtils.FindFirst(folder+PathDelim+'checkpoint*'+CT_Safebox_Extension, FileAttrs, sr) = 0 then begin
+ repeat
+ if (sr.Attr and FileAttrs) = FileAttrs then begin
+ auxfn := folder+PathDelim+sr.Name;
+ if TPCAbstractMem.AnalyzeFile(auxfn,LTempBlocksCount) then begin
+ if (((AMax_block<0) Or (LTempBlocksCount<=AMax_block)) AND (LTempBlocksCount>LBlockscount)) then begin
+ Lfilename := auxfn;
+ LBlockscount := LTempBlocksCount;
+ end;
+ end;
+ end;
+ until FindNext(sr) <> 0;
+ FindClose(sr);
+ end;
+ if (Lfilename='') then begin
+ SafeBox.SetSafeboxFileName(LSafeboxFileName);
+ end else begin
+ SafeBox.SetSafeboxFileName(Lfilename);
+ SafeBox.UpdateSafeboxFileName(LSafeboxFileName);
+ end;
+ {$ELSE}
+ LBlockscount := 0;
+ {$ENDIF}
+ FileAttrs := faArchive;
+ folder := GetStorageFolder(AOrphan);
+ Lfilename := '';
+ if SysUtils.FindFirst(folder+PathDelim+'*.safebox', FileAttrs, sr) = 0 then begin
+ repeat
+ if (sr.Attr and FileAttrs) = FileAttrs then begin
+ auxfn := folder+PathDelim+sr.Name;
+ If LoadBankFileInfo(auxfn,sbHeader) then begin
+ if (((AMax_block<0) Or (sbHeader.endBlock<=AMax_block)) AND (sbHeader.blocksCount>LBlockscount)) And
+ (sbHeader.startBlock=0) And (sbHeader.endBlock=sbHeader.startBlock+sbHeader.blocksCount-1) then begin
+ Lfilename := auxfn;
+ LBlockscount := sbHeader.blocksCount;
+ goodSbHeader := sbHeader;
+ end;
+ end;
+ end;
+ until FindNext(sr) <> 0;
+ FindClose(sr);
+ end;
+ if (Lfilename<>'') then begin
+ TLog.NewLog(ltinfo,Self.ClassName,'Loading SafeBox protocol:'+IntToStr(goodSbHeader.protocol)+' with '+inttostr(LBlockscount)+' blocks from file '+Lfilename);
+ fs := TFileStream.Create(Lfilename,fmOpenRead);
+ try
+ fs.Position := 0;
+ if not LoadBankFromStream(fs,False,Nil,Nil,ARestoreProgressNotify,errors) then begin
+ TLog.NewLog(lterror,ClassName,'Error reading bank from file: '+Lfilename+ ' Error: '+errors);
+ end;
+ finally
+ fs.Free;
+ end;
+ end;
+ Finally
+ FBankLock.Release;
+ End;
+end;
+
+function TPCBank.SaveBank(forceSave: Boolean): Boolean;
+begin
+ Result := true;
+ If Storage.FIsMovingBlockchain then Exit;
+ if (Not forceSave) AND (Not TPCSafeBox.MustSafeBoxBeSaved(BlocksCount)) then exit; // No save
+ Try
+ Result := DoSaveBank;
+ {$IFnDEF USE_ABSTRACTMEM}
+ SafeBox.CheckMemory;
+ {$ENDIF}
+ Except
+ On E:Exception do begin
+ TLog.NewLog(lterror,Classname,'Error saving Bank: '+E.Message);
+ Raise;
+ end;
+ End;
+end;
+
procedure TPCBank.SetStorageClass(const Value: TStorageClass);
begin
if FStorageClass=Value then exit;
@@ -1468,6 +1724,8 @@ procedure TPCOperationsComp.Clear(DeleteOperations : Boolean);
{$ENDIF}
end else if (FOperationBlock.protocol_version=CT_PROTOCOL_4) And (FBank.SafeBox.CanUpgradeToProtocol(CT_PROTOCOL_5)) then begin
FOperationBlock.protocol_version := CT_PROTOCOL_5; // If minting... upgrade to Protocol 5
+ end else if (FOperationBlock.protocol_version=CT_PROTOCOL_5) And (FBank.SafeBox.CanUpgradeToProtocol(CT_PROTOCOL_6)) then begin
+ FOperationBlock.protocol_version := CT_PROTOCOL_6; // If minting... upgrade to Protocol 6
end;
if (FOperationBlock.protocol_version>=CT_PROTOCOL_4) then begin
FOperationsHashTree.Max0feeOperationsBySigner := 1; // Limit to 1 0-fee operation by signer
@@ -1492,7 +1750,7 @@ procedure TPCOperationsComp.Clear(DeleteOperations : Boolean);
FOperationsHashTree.Max0feeOperationsBySigner := -1;
FOperationBlock.previous_proof_of_work := Nil;
end;
- FOperationBlock.operations_hash := FOperationsHashTree.HashTree;
+ FOperationBlock.operations_hash := Copy(FOperationsHashTree.HashTree);
FOperationBlock.fee := 0;
FOperationBlock.nonce := 0;
FOperationBlock.proof_of_work:=Nil;
@@ -1689,8 +1947,12 @@ function TPCOperationsComp.LoadBlockFromStreamExt(Stream: TStream; LoadingFromSt
errors := 'Invalid protocol structure. Check application version!';
exit;
end;
- soob := 255;
- Stream.Read(soob,1);
+
+ if Not LoadOperationBlockFromStream(Stream,soob,FOperationBlock) then begin
+ errors := 'Cannot load operationBlock';
+ Exit;
+ end;
+
// About soob var:
// In build prior to 1.0.4 soob only can have 2 values: 0 or 1
// In build 1.0.4 soob can has 2 more values: 2 or 3
@@ -1718,32 +1980,10 @@ function TPCOperationsComp.LoadBlockFromStreamExt(Stream: TStream; LoadingFromSt
exit;
end;
- if (soob in [2,3,4,5]) then begin
- Stream.Read(FOperationBlock.protocol_version, Sizeof(FOperationBlock.protocol_version));
- Stream.Read(FOperationBlock.protocol_available, Sizeof(FOperationBlock.protocol_available));
- end else begin
- // We assume that protocol_version is 1 and protocol_available is 0
- FOperationBlock.protocol_version := 1;
- FOperationBlock.protocol_available := 0;
- end;
-
- if Stream.Read(FOperationBlock.block, Sizeof(FOperationBlock.block))<0 then exit;
-
- if TStreamOp.ReadAnsiString(Stream, raw) < 0 then exit;
- FOperationBlock.account_key := TAccountComp.RawString2Accountkey(raw);
- if Stream.Read(FOperationBlock.reward, Sizeof(FOperationBlock.reward)) < 0 then exit;
- if Stream.Read(FOperationBlock.fee, Sizeof(FOperationBlock.fee)) < 0 then exit;
- if Stream.Read(FOperationBlock.timestamp, Sizeof(FOperationBlock.timestamp)) < 0 then exit;
- if Stream.Read(FOperationBlock.compact_target, Sizeof(FOperationBlock.compact_target)) < 0 then exit;
- if Stream.Read(FOperationBlock.nonce, Sizeof(FOperationBlock.nonce)) < 0 then exit;
- if TStreamOp.ReadAnsiString(Stream, FOperationBlock.block_payload) < 0 then exit;
- if TStreamOp.ReadAnsiString(Stream, FOperationBlock.initial_safe_box_hash) < 0 then exit;
- if TStreamOp.ReadAnsiString(Stream, FOperationBlock.operations_hash) < 0 then exit;
- if TStreamOp.ReadAnsiString(Stream, FOperationBlock.proof_of_work) < 0 then exit;
if FOperationBlock.protocol_version>=CT_PROTOCOL_5 then begin
- if TStreamOp.ReadAnsiString(Stream, FOperationBlock.previous_proof_of_work) < 0 then exit;
load_protocol_version := FOperationBlock.protocol_version;
end;
+
If FIsOnlyOperationBlock then begin
Result := true;
exit;
@@ -1785,6 +2025,41 @@ function TPCOperationsComp.LoadBlockFromStreamExt(Stream: TStream; LoadingFromSt
end;
end;
+class function TPCOperationsComp.LoadOperationBlockFromStream(AStream: TStream; var Asoob : Byte;
+ var AOperationBlock: TOperationBlock): Boolean;
+var Lraw : TBytes;
+begin
+ Result := False;
+ AStream.Read(Asoob,1);
+ if (Asoob in [2,3,4,5]) then begin
+ if AStream.Read(AOperationBlock.protocol_version, Sizeof(AOperationBlock.protocol_version)) < 0 then Exit;
+ AStream.Read(AOperationBlock.protocol_available, Sizeof(AOperationBlock.protocol_available));
+ end else begin
+ // We assume that protocol_version is 1 and protocol_available is 0
+ AOperationBlock.protocol_version := 1;
+ AOperationBlock.protocol_available := 0;
+ end;
+
+ if AStream.Read(AOperationBlock.block, Sizeof(AOperationBlock.block))<=0 then exit;
+
+ if TStreamOp.ReadAnsiString(AStream, Lraw) < 0 then exit;
+ AOperationBlock.account_key := TAccountComp.RawString2Accountkey(Lraw);
+
+ if AStream.Read(AOperationBlock.reward, Sizeof(AOperationBlock.reward)) < 0 then exit;
+ if AStream.Read(AOperationBlock.fee, Sizeof(AOperationBlock.fee)) < 0 then exit;
+ if AStream.Read(AOperationBlock.timestamp, Sizeof(AOperationBlock.timestamp)) < 0 then exit;
+ if AStream.Read(AOperationBlock.compact_target, Sizeof(AOperationBlock.compact_target)) < 0 then exit;
+ if AStream.Read(AOperationBlock.nonce, Sizeof(AOperationBlock.nonce)) < 0 then exit;
+ if TStreamOp.ReadAnsiString(AStream, AOperationBlock.block_payload) < 0 then exit;
+ if TStreamOp.ReadAnsiString(AStream, AOperationBlock.initial_safe_box_hash) < 0 then exit;
+ if TStreamOp.ReadAnsiString(AStream, AOperationBlock.operations_hash) < 0 then exit;
+ if TStreamOp.ReadAnsiString(AStream, AOperationBlock.proof_of_work) < 0 then exit;
+ if AOperationBlock.protocol_version>=CT_PROTOCOL_5 then begin
+ if TStreamOp.ReadAnsiString(AStream, AOperationBlock.previous_proof_of_work) < 0 then exit;
+ end;
+ Result := True;
+end;
+
class function TPCOperationsComp.OperationBlockToText(const OperationBlock: TOperationBlock): String;
begin
Result := Format('Block:%d Timestamp:%d Reward:%d Fee:%d Target:%d PoW:%s Payload:%s Nonce:%d OperationsHash:%s SBH:%s',[operationBlock.block,
@@ -1836,6 +2111,8 @@ procedure TPCOperationsComp.SanitizeOperations;
{$ENDIF}
end else if (FOperationBlock.protocol_version=CT_PROTOCOL_4) And (FBank.SafeBox.CanUpgradeToProtocol(CT_PROTOCOL_5)) then begin
FOperationBlock.protocol_version := CT_PROTOCOL_5; // If minting... upgrade to Protocol 5
+ end else if (FOperationBlock.protocol_version=CT_PROTOCOL_5) And (FBank.SafeBox.CanUpgradeToProtocol(CT_PROTOCOL_6)) then begin
+ FOperationBlock.protocol_version := CT_PROTOCOL_6; // If minting... upgrade to Protocol 6
end;
FOperationBlock.block := FBank.BlocksCount;
@@ -2065,6 +2342,11 @@ procedure TPCOperationsComp.SetnOnce(const value: Cardinal);
Update_And_RecalcPOW(value,FOperationBlock.timestamp,FOperationBlock.block_payload);
end;
+procedure TPCOperationsComp.SetOperationBlock(const ANewValues: TOperationBlock);
+begin
+ FOperationBlock := ANewValues;
+end;
+
procedure TPCOperationsComp.Settimestamp(const value: Cardinal);
begin
Update_And_RecalcPOW(FOperationBlock.nonce,value,FOperationBlock.block_payload);
@@ -2098,6 +2380,50 @@ function TPCOperationsComp.GetMinerRewardPseudoOperation : TOperationResume;
Result.OperationTxt := 'Miner reward';
end;
+function TPCOperationsComp.AddMinerRecover(LRecoverAccounts: TAccountList; const ANewAccountKey : TAccountKey): Boolean;
+var
+ LAccount: TAccount;
+ LOpRecoverFounds: TOpRecoverFounds;
+ i: Integer;
+ errors: string;
+ LmaxFee : UInt64;
+begin
+ Self.Lock;
+ errors := '';
+ Result := True;
+ try
+ for i:=0 to LRecoverAccounts.Count-1 do begin
+ LAccount := LRecoverAccounts[i];
+ LmaxFee := LAccount.balance;
+ if LMaxFee>CT_MaxTransactionFee then LMaxFee := CT_MaxTransactionFee;
+ LOpRecoverFounds := TOpRecoverFounds.Create(
+ Self.OperationBlock.protocol_version,
+ LAccount.account,
+ LAccount.n_operation+1,
+ LmaxFee,
+ ANewAccountKey
+ );
+ try
+ if not(
+ Self.AddOperation(
+ True,
+ LOpRecoverFounds,
+ errors
+ )
+ ) then begin
+ // if it fails then it number of operations could be maxed out, not a problem
+ TLog.NewLog(lterror,ClassName,Format('Cannot add OpRecover %d/%d %s error %s',[i+1,LRecoverAccounts.Count,LOpRecoverFounds.ToString,errors]));
+ Break;
+ end;
+ finally
+ LOpRecoverFounds.Free;
+ end;
+ end;
+ finally
+ Self.Unlock;
+ end;
+end;
+
function TPCOperationsComp.ValidateOperationBlock(var errors : String): Boolean;
Var i : Integer;
begin
@@ -2273,6 +2599,7 @@ procedure TOperationsHashTree.ClearHastThree;
FListOrderedByAccountsData.Clear;
FListOrderedByOpReference.Clear;
FHashTree:=Nil;
+ FHasOpRecoverOperations := False;
End;
If Assigned(FOnChanged) then FOnChanged(Self);
finally
@@ -2328,6 +2655,7 @@ constructor TOperationsHashTree.Create;
FHashTree := Nil;
FMax0feeOperationsBySigner := -1; // Unlimited by default
FHashTreeOperations := TPCThreadList.Create('TOperationsHashTree_HashTreeOperations');
+ FHasOpRecoverOperations := False;
end;
procedure TOperationsHashTree.Delete(index: Integer);
@@ -2456,13 +2784,13 @@ function TOperationsHashTree.GetOperation(index: Integer): TPCOperation;
function TOperationsHashTree.GetOperationsAffectingAccount(account_number: Cardinal; List: TList): Integer;
// This function retrieves operations from HashTree that affeccts to an account_number
Var l : TList;
- intl : TList;
+ intl : TOrderedList;
i,j : Integer;
begin
List.Clear;
l := FHashTreeOperations.LockList;
try
- intl := TList.Create;
+ intl := TOrderedList.Create(False,TComparison_Cardinal);
try
for i := 0 to l.Count - 1 do begin
intl.Clear;
@@ -2558,6 +2886,7 @@ function TOperationsHashTree.InternalAddOperationToHashTree(list: TList
Result := False;
Exit;
end else Result := True; // Will add:
+ if (op is TOpRecoverFounds) then FHasOpRecoverOperations := True;
New(P);
if Not _PCOperationsStorage.FindPCOperationAndIncCounterIfFound(op) then begin
msCopy := TMemoryStream.Create;
@@ -2727,7 +3056,11 @@ function TOperationsHashTree.FindOrderedByOpReference(lockedThreadList: TList0) then begin
+ AddOperationToHashTree(LOperation);
+ inc(AProcessedCount);
+ end else begin
+ {$IFDEF HIGHLOG}TLog.NewLog(ltdebug,ClassName,Format('Not added a 0fee operation: %s',[LOperation.ToString]));{$ENDIF}
+ end;
Finally
FreeAndNil(LOperation);
end;
@@ -2806,11 +3148,17 @@ function TOperationsHashTree.LoadOperationsHashTreeFromStream(AStream: TStream;
end;
If Assigned(FOnChanged) then FOnChanged(Self);
AErrors := '';
- Result := true;
+ Result := True;
+end;
+
+function TOperationsHashTree.LoadOperationsHashTreeFromStream(AStream: TStream; ALoadingFromStorage : Boolean; ASetOperationsToProtocolVersion : Word; ALoadFromStorageVersion : Word; APreviousUpdatedBlocks : TAccountPreviousBlockInfo; var AErrors : String): Boolean;
+var Lopc,Lprc : Integer;
+begin
+ Result := LoadOperationsHashTreeFromStream(AStream,ALoadingFromStorage,ASetOperationsToProtocolVersion,ALoadFromStorageVersion,APreviousUpdatedBlocks,True,Lopc,Lprc,AErrors);
end;
procedure TOperationsHashTree.MarkVerifiedECDSASignatures(operationsHashTreeToMark: TOperationsHashTree);
-var i, iPosInMyList, nMarkedAsGood, nAlreadyMarked : Integer;
+var i, iPosInMyList, nMarkedAsGood, nAlreadyMarked, nFound : Integer;
opToMark, opInMyList : TPCOperation;
myList, listToMark : TList;
begin
@@ -2819,6 +3167,7 @@ procedure TOperationsHashTree.MarkVerifiedECDSASignatures(operationsHashTreeToMa
If Self=operationsHashTreeToMark then Exit;
nMarkedAsGood := 0;
nAlreadyMarked := 0;
+ nFound := 0;
myList := FHashTreeOperations.LockList;
try
if myList.Count<=0 then Exit; // Nothing to search...
@@ -2831,6 +3180,7 @@ procedure TOperationsHashTree.MarkVerifiedECDSASignatures(operationsHashTreeToMa
// Check if found
iPosInMyList := Self.IndexOfOperation(opToMark);
if (iPosInMyList>=0) then begin
+ inc(nFound);
opInMyList := POperationHashTreeReg(myList[iPosInMyList])^.Op;
if (opInMyList.FHasValidSignature) then begin
if (opToMark.FHasValidSignature) then inc(nAlreadyMarked)
@@ -2844,7 +3194,9 @@ procedure TOperationsHashTree.MarkVerifiedECDSASignatures(operationsHashTreeToMa
end;
end;
end;
- TLog.NewLog(ltdebug,ClassName,Format('Marked %d/%d operations as ValidSignature (%d before) from MemPool with %d operations',[nMarkedAsGood,listToMark.Count,nAlreadyMarked,myList.Count]));
+ if (nFound>0) then begin
+ TLog.NewLog(ltdebug,ClassName,Format('Marked %d/%d operations (%d found) as ValidSignature (%d before) from MemPool with %d operations',[nMarkedAsGood,listToMark.Count,nFound,nAlreadyMarked,myList.Count]));
+ end;
finally
operationsHashTreeToMark.FHashTreeOperations.UnlockList;
end;
@@ -2937,15 +3289,16 @@ function TStorage.BlockExists(Block: Cardinal): Boolean;
procedure TStorage.CopyConfiguration(const CopyFrom: TStorage);
begin
- Orphan := CopyFrom.Orphan;
+ ReadOnly := CopyFrom.ReadOnly;
end;
constructor TStorage.Create(AOwner: TComponent);
begin
inherited;
- FOrphan := '';
FReadOnly := false;
FIsMovingBlockchain := False;
+ FPendingBufferOperationsStream := Nil;
+ FStorageFilename := '';
end;
procedure TStorage.DeleteBlockChainBlocks(StartingDeleteBlock: Cardinal);
@@ -2954,14 +3307,287 @@ procedure TStorage.DeleteBlockChainBlocks(StartingDeleteBlock: Cardinal);
DoDeleteBlockChainBlocks(StartingDeleteBlock);
end;
-function TStorage.Initialize: Boolean;
+destructor TStorage.Destroy;
begin
- Result := DoInitialize;
+ FreeAndNil(FPendingBufferOperationsStream);
+ inherited;
end;
-function TStorage.OpenSafeBoxCheckpoint(blockCount: Cardinal): TCheckPointStruct;
+function TStorage.DoFindOperation(const AOpHash: TBytes; var AOperationResume: TOperationResume): TSearchOpHashResult;
+var LBlock, LAccount, LN_Operation : Cardinal;
+ LMD160,LOpHashValid,LOpHashOld : TBytes;
+ i,LPreviousBlock, LAux_n_op,LInitialBlock : Integer;
+ LOperationsComp : TPCOperationsComp;
+ LOp : TPCOperation;
begin
- Result := DoOpenSafeBoxCheckpoint(blockCount);
+ Result := OpHash_invalid_params;
+ If not TPCOperation.DecodeOperationHash(AOpHash,LBlock,LAccount,LN_Operation,LMD160) then exit;
+ LInitialBlock := LBlock;
+ If (LAccount>=Bank.AccountsCount) then exit; // Invalid account number
+ // If block=0 then we must search in pending operations first
+ if (LBlock=0) then begin
+ // block=0 and not found... start searching at block updated by account updated_block
+ LBlock := Bank.SafeBox.Account(LAccount).GetLastUpdatedBlock;
+ end;
+ if Bank.SafeBox.Account(LAccount).n_operation=Bank.BlocksCount) then exit;
+ //
+ // Search in previous blocks
+ LOperationsComp := TPCOperationsComp.Create(Bank);
+ try
+ While (LBlock>0) do begin
+ LPreviousBlock := LBlock;
+ If Not Bank.LoadOperations(LOperationsComp,LBlock) then begin
+ Result := OpHash_block_not_found;
+ exit;
+ end;
+ For i:=LOperationsComp.Count-1 downto 0 do begin
+ LOp := LOperationsComp.Operation[i];
+ if (LOp.IsSignerAccount(LAccount)) then begin
+ LAux_n_op := LOp.GetAccountN_Operation(LAccount);
+ If (LAux_n_op=LPreviousBlock) then exit; // Error... not found a valid block positioning
+ if (LInitialBlock<>0) then exit; // If not found in specified block, no valid hash
+ end;
+ finally
+ LOperationsComp.Free;
+ end;
+end;
+
+function TStorage.DoGetAccountOperations(AAccount, AMaxDepth, AStartOperation,
+ AMaxOperations, ASearchBackwardsStartingAtBlock: Integer;
+ const AOperationsResumeList:TOperationsResumeList): Boolean;
+ // Optimization:
+ // For better performance, will only include at "OperationsResume" values betweeen "startOperation" and "endOperation"
+
+ // New use case: Will allow to start in an unknown block when first_block_is_unknows
+ Procedure DoGetFromBlock(block_number : Integer; last_balance : Int64; act_depth : Integer; nOpsCounter : Integer; first_block_is_unknown : Boolean);
+ var opc : TPCOperationsComp;
+ op : TPCOperation;
+ OPR : TOperationResume;
+ LAccounts : TList;
+ i : Integer;
+ last_block_number : Integer;
+ found_in_block : Boolean;
+ acc_0_miner_reward, acc_4_dev_reward : Int64;
+ acc_4_for_dev : Boolean;
+ begin
+ if (act_depth=0) then exit;
+ opc := TPCOperationsComp.Create(Nil);
+ Try
+ LAccounts := TList.Create;
+ try
+ last_block_number := block_number+1;
+ while (last_block_number>block_number) And (act_depth<>0)
+ And (block_number >= (AAccount DIV CT_AccountsPerBlock))
+ And (AMaxOperations<>0)
+ do begin
+ found_in_block := False;
+ last_block_number := block_number;
+ LAccounts.Clear;
+ If not Bank.Storage.LoadBlockChainBlock(opc,block_number) then begin
+ exit;
+ end;
+ opc.OperationsHashTree.GetOperationsAffectingAccount(AAccount,LAccounts);
+ for i := LAccounts.Count - 1 downto 0 do begin
+ op := opc.Operation[(LAccounts.Items[i])];
+ If TPCOperation.OperationToOperationResume(block_number,Op,False,AAccount,OPR) then begin
+ OPR.NOpInsideBlock := (LAccounts.Items[i]);
+ OPR.time := opc.OperationBlock.timestamp;
+ OPR.Block := block_number;
+ If last_balance>=0 then begin
+ OPR.Balance := last_balance;
+ last_balance := last_balance - ( OPR.Amount + OPR.Fee );
+ end else OPR.Balance := -1; // Undetermined
+ if (nOpsCounter>=AStartOperation) And (AMaxOperations<>0) then begin
+ AOperationsResumeList.Add(OPR);
+ end;
+ inc(nOpsCounter);
+ Dec(AMaxOperations);
+ found_in_block := True;
+ end;
+ end;
+
+ // Is a new block operation?
+ if (TAccountComp.AccountBlock(AAccount)=block_number) then begin
+ TPascalCoinProtocol.GetRewardDistributionForNewBlock(opc.OperationBlock,acc_0_miner_reward,acc_4_dev_reward,acc_4_for_dev);
+ If ((AAccount MOD CT_AccountsPerBlock)=0) Or
+ ( ((AAccount MOD CT_AccountsPerBlock)=CT_AccountsPerBlock-1) AND (acc_4_for_dev) ) then begin
+ OPR := CT_TOperationResume_NUL;
+ OPR.OpType:=CT_PseudoOp_Reward;
+ OPR.valid := true;
+ OPR.Block := block_number;
+ OPR.time := opc.OperationBlock.timestamp;
+ OPR.AffectedAccount := AAccount;
+ If ((AAccount MOD CT_AccountsPerBlock)=0) then begin
+ OPR.Amount := acc_0_miner_reward;
+ OPR.OperationTxt := 'Miner reward';
+ OPR.OpSubtype:=CT_PseudoOpSubtype_Miner;
+ end else begin
+ OPR.Amount := acc_4_dev_reward;
+ OPR.OperationTxt := 'Dev reward';
+ OPR.OpSubtype:=CT_PseudoOpSubtype_Developer;
+ end;
+ If last_balance>=0 then begin
+ OPR.Balance := last_balance;
+ end else OPR.Balance := -1; // Undetermined
+ if (nOpsCounter>=AStartOperation) And (AMaxOperations<>0) then begin
+ AOperationsResumeList.Add(OPR);
+ end;
+ inc(nOpsCounter);
+ dec(AMaxOperations);
+ found_in_block := True;
+ end;
+ end;
+ //
+ dec(act_depth);
+ If (Not found_in_block) And (first_block_is_unknown) then begin
+ Dec(block_number);
+ end else begin
+ block_number := opc.PreviousUpdatedBlocks.GetPreviousUpdatedBlock(AAccount,block_number);
+ end;
+ opc.Clear(true);
+ end;
+ finally
+ LAccounts.Free;
+ end;
+ Finally
+ opc.Free;
+ End;
+ end;
+
+Var acc : TAccount;
+ startBlock : Cardinal;
+ lastBalance : Int64;
+begin
+ Result := False;
+ if AMaxDepth=0 then Exit;
+ if AAccount>=Bank.SafeBox.AccountsCount then Exit;
+ if AMaxOperations=0 then Exit;
+ Result := True;
+ acc := Bank.SafeBox.Account(AAccount);
+ if (acc.GetLastUpdatedBlock>0) Or (acc.account=0) then Begin
+ if (ASearchBackwardsStartingAtBlock=0) Or (ASearchBackwardsStartingAtBlock>=acc.GetLastUpdatedBlock) then begin
+ startBlock := acc.GetLastUpdatedBlock;
+ lastBalance := acc.balance;
+ end else begin
+ startBlock := ASearchBackwardsStartingAtBlock;
+ lastBalance := -1;
+ end;
+ DoGetFromBlock(startBlock,lastBalance,AMaxDepth,0,startBlock<>acc.GetLastUpdatedBlock);
+ end;
+end;
+
+function TStorage.DoGetBlockInformation(const ABlock: Integer;
+ var AOperationBlock: TOperationBlock; var AOperationsCount: Integer;
+ var AVolume: Int64): Boolean;
+var LPCOperations : TPCOperationsComp;
+begin
+ AOperationBlock:=CT_OperationBlock_NUL;
+ AOperationsCount := 0;
+ AVolume := 0;
+ //
+ LPCOperations := TPCOperationsComp.Create(Bank);
+ Try
+ if Not LoadBlockChainBlock(LPCOperations,ABlock) then begin
+ Exit(False);
+ end else Result := True;
+ AOperationBlock := LPCOperations.OperationBlock.GetCopy;
+ AOperationsCount := LPCOperations.Count;
+ AVolume := LPCOperations.OperationsHashTree.TotalAmount;
+ Finally
+ LPCOperations.Free;
+ End;
+end;
+
+function TStorage.DoGetBlockOperations(ABlock, AOpBlockStartIndex,
+ AMaxOperations: Integer; var AOperationBlock: TOperationBlock;
+ var AOperationsCount: Integer; var AVolume: Int64;
+ const AOperationsResumeList:TOperationsResumeList): Boolean;
+var LPCOperations : TPCOperationsComp;
+ LOpResume : TOperationResume;
+ LOp : TPCOperation;
+begin
+ AOperationBlock:=CT_OperationBlock_NUL;
+ AOperationsCount := 0;
+ AVolume := 0;
+ LPCOperations := TPCOperationsComp.Create(Bank);
+ Try
+ if Not LoadBlockChainBlock(LPCOperations,ABlock) then begin
+ Exit(False);
+ end;
+ AOperationBlock := LPCOperations.OperationBlock.GetCopy;
+ AOperationsCount := LPCOperations.Count;
+ AVolume := LPCOperations.OperationsHashTree.TotalAmount;
+ while (AMaxOperations<>0) and (AOpBlockStartIndex>=0) and (AOpBlockStartIndex0 then begin
+ if Assigned(Bank) then LCurrentProtocol := Bank.SafeBox.CurrentProtocol
+ else LCurrentProtocol := CT_BUILD_PROTOCOL;
+ If OperationsHashTree.LoadOperationsHashTreeFromStream(fs,true,LCurrentProtocol,LCurrentProtocol, Nil,errors) then begin
+ TLog.NewLog(ltInfo,ClassName,Format('DoLoadPendingBufferOperations loaded operations:%d',[OperationsHashTree.OperationsCount]));
+ end else TLog.NewLog(ltError,ClassName,Format('DoLoadPendingBufferOperations ERROR (Protocol %d): loaded operations:%d errors:%s',[LCurrentProtocol,OperationsHashTree.OperationsCount,errors]));
+ end;
+end;
+
+procedure TStorage.DoSavePendingBufferOperations(
+ OperationsHashTree: TOperationsHashTree);
+Var fs : TFileStream;
+begin
+ fs := GetPendingBufferOperationsStream;
+ fs.Position:=0;
+ fs.Size:=0;
+ OperationsHashTree.SaveOperationsHashTreeToStream(fs,true);
+ {$IFDEF HIGHLOG}TLog.NewLog(ltdebug,ClassName,Format('DoSavePendingBufferOperations operations:%d',[OperationsHashTree.OperationsCount]));{$ENDIF}
+end;
+
+function TStorage.Initialize: Boolean;
+begin
+ Result := DoInitialize;
end;
procedure TStorage.EraseStorage;
@@ -2970,6 +3596,62 @@ procedure TStorage.EraseStorage;
DoEraseStorage;
end;
+function TStorage.FindOperation(const AOpHash: TBytes;
+ var AOperationResume: TOperationResume): TSearchOpHashResult;
+begin
+ Result := DoFindOperation(AOpHash,AOperationResume);
+end;
+
+function TStorage.GetAccountOperations(AAccount, AMaxDepth, AStartOperation,
+ AMaxOperations, ASearchBackwardsStartingAtBlock: Integer;
+ const AOperationsResumeList:TOperationsResumeList): Boolean;
+begin
+ Result := DoGetAccountOperations(AAccount,AMaxDepth,AStartOperation,AMaxOperations,ASearchBackwardsStartingAtBlock,AOperationsResumeList);
+end;
+
+function TStorage.GetBlockInformation(ABlock: Integer;
+ var AOperationBlock: TOperationBlock; var AOperationsCount: Integer;
+ var AVolume: Int64): Boolean;
+begin
+ if (ABlockLastBlock) then begin
+ AOperationBlock := CT_OperationBlock_NUL;
+ AOperationsCount := 0;
+ AVolume := 0;
+ Result := false;
+ end else Result := DoGetBlockInformation(ABlock,AOperationBlock,AOperationsCount,AVolume);
+end;
+
+function TStorage.GetBlockOperations(ABlock, AOpBlockStartIndex,
+ AMaxOperations: Integer; var AOperationBlock: TOperationBlock;
+ var AOperationsCount: Integer; var AVolume: Int64;
+ const AOperationsResumeList:TOperationsResumeList): Boolean;
+begin
+ if (ABlockLastBlock) then begin
+ Result := false;
+ end else Result := DoGetBlockOperations(ABlock,AOpBlockStartIndex,AMaxOperations,AOperationBlock,AOperationsCount,AVolume,AOperationsResumeList);
+end;
+
+function TStorage.GetPendingBufferOperationsStream: TFileStream;
+Var fs : TFileStream;
+ fn : TFileName;
+ fm : Word;
+begin
+ If Not Assigned(FPendingBufferOperationsStream) then begin
+ fn := Bank.GetStorageFolder(Bank.Orphan)+PathDelim+'pendingbuffer.ops';
+ If FileExists(fn) then fm := fmOpenReadWrite+fmShareExclusive
+ else fm := fmCreate+fmShareExclusive;
+ Try
+ FPendingBufferOperationsStream := TFileStream.Create(fn,fm);
+ Except
+ On E:Exception do begin
+ TLog.NewLog(ltError,ClassName,'Error opening PendingBufferOperationsStream '+fn+' ('+E.ClassName+'):'+ E.Message);
+ Raise;
+ end;
+ end;
+ end;
+ Result := FPendingBufferOperationsStream;
+end;
+
procedure TStorage.SavePendingBufferOperations(OperationsHashTree : TOperationsHashTree);
begin
DoSavePendingBufferOperations(OperationsHashTree);
@@ -2987,32 +3669,82 @@ function TStorage.LoadBlockChainBlock(Operations: TPCOperationsComp; Block: Card
end;
function TStorage.MoveBlockChainBlocks(StartBlock: Cardinal; const DestOrphan: TOrphan; DestStorage : TStorage): Boolean;
+ Procedure DoCopySafebox;
+ var sr: TSearchRec;
+ FileAttrs: Integer;
+ folder : AnsiString;
+ sourcefn,destfn : AnsiString;
+ begin
+ FileAttrs := faArchive;
+ folder := Bank.GetStorageFolder(Bank.Orphan);
+ if SysUtils.FindFirst(Bank.GetStorageFolder(Bank.Orphan)+PathDelim+'checkpoint*'+CT_Safebox_Extension, FileAttrs, sr) = 0 then begin
+ repeat
+ if (sr.Attr and FileAttrs) = FileAttrs then begin
+ sourcefn := Bank.GetStorageFolder(Bank.Orphan)+PathDelim+sr.Name;
+ destfn := Bank.GetStorageFolder('')+PathDelim+sr.Name;
+ TLog.NewLog(ltInfo,ClassName,'Copying safebox file '+sourcefn+' to '+destfn);
+ Try
+ {$IFDEF FPC}
+ DoCopyFile(sourcefn,destfn);
+ {$ELSE}
+ CopyFile(PWideChar(sourcefn),PWideChar(destfn),False);
+ {$ENDIF}
+ Except
+ On E:Exception do begin
+ TLog.NewLog(ltError,Classname,'Error copying file: ('+E.ClassName+') '+E.Message);
+ end;
+ End;
+ end;
+ until FindNext(sr) <> 0;
+ FindClose(sr);
+ end;
+ End;
+Var
+ LOperationsComp : TPCOperationsComp;
+ LCurrentBlock : Integer;
begin
if Assigned(DestStorage) then begin
if DestStorage.ReadOnly then raise Exception.Create('Cannot move blocks because is ReadOnly');
- end else if ReadOnly then raise Exception.Create('Cannot move blocks from myself because is ReadOnly');
- Result := DoMoveBlockChain(StartBlock,DestOrphan,DestStorage);
-end;
-
-function TStorage.RestoreBank(max_block: Int64; restoreProgressNotify : TProgressNotify = Nil): Boolean;
-begin
- Result := DoRestoreBank(max_block,restoreProgressNotify);
+ // Move process:
+ try
+ try
+ DestStorage.FIsMovingBlockchain:=True;
+ DestStorage.Bank.Orphan := DestOrphan;
+ LOperationsComp := TPCOperationsComp.Create(Nil);
+ try
+ LCurrentBlock := StartBlock;
+ while LoadBlockChainBlock(LOperationsComp,LCurrentBlock) do begin
+ inc(LCurrentBlock);
+ TLog.NewLog(ltDebug,Classname,'Moving block from "'+Orphan+'" to "'+DestOrphan+'" '+TPCOperationsComp.OperationBlockToText(LOperationsComp.OperationBlock));
+ DestStorage.SaveBlockChainBlock(LOperationsComp);
+ end;
+ TLog.NewLog(ltdebug,Classname,'Moved blockchain from "'+Orphan+'" to "'+DestOrphan+'" from block '+inttostr(StartBlock)+' to '+inttostr(LCurrentBlock-1));
+ finally
+ LOperationsComp.Free;
+ end;
+ finally
+ DestStorage.FIsMovingBlockchain:=False;
+ end;
+ Except
+ On E:Exception do begin
+ TLog.NewLog(lterror,ClassName,'Error at DoMoveBlockChain: ('+E.ClassName+') '+E.Message);
+ Raise;
+ end;
+ End;
+ end else begin
+ if ReadOnly then raise Exception.Create('Cannot move blocks from myself because is ReadOnly');
+ Result := DoMoveBlockChain(StartBlock,DestOrphan);
+ end;
+ // If DestOrphan is empty, then copy possible updated safebox (because, perhaps current saved safebox is from invalid blockchain)
+ if (DestOrphan='') And (Orphan<>'') then begin
+ DoCopySafebox;
+ end;
end;
-function TStorage.SaveBank(forceSave : Boolean): Boolean;
+function TStorage.Orphan: String;
begin
- Result := true;
- If FIsMovingBlockchain then Exit;
- if (Not forceSave) AND (Not TPCSafeBox.MustSafeBoxBeSaved(Bank.BlocksCount)) then exit; // No save
- Try
- Result := DoSaveBank;
- FBank.SafeBox.CheckMemory;
- Except
- On E:Exception do begin
- TLog.NewLog(lterror,Classname,'Error saving Bank: '+E.Message);
- Raise;
- end;
- End;
+ if Assigned(Bank) then Result := Bank.Orphan
+ else Result := '';
end;
function TStorage.SaveBlockChainBlock(Operations: TPCOperationsComp): Boolean;
@@ -3033,11 +3765,6 @@ procedure TStorage.SetBank(const Value: TPCBank);
FBank := Value;
end;
-procedure TStorage.SetOrphan(const Value: TOrphan);
-begin
- FOrphan := Value;
-end;
-
procedure TStorage.SetReadOnly(const Value: Boolean);
begin
FReadOnly := Value;
@@ -3054,6 +3781,29 @@ constructor TPCOperation.Create(AProtocolVersion : Word);
InitializeData(AProtocolVersion);
end;
+class function TPCOperation.CreateOperationFromStream(AStream: TStream;
+ var AOperation: TPCOperation): Boolean;
+var LOpTypeWord, LOpProtocolVersion : Word;
+ LOpClass : TPCOperationClass;
+begin
+ AOperation := Nil;
+ AStream.Read(LOpTypeWord, 2);
+ AStream.Read(LOpProtocolVersion, 2);
+
+ LOpClass := TPCOperationsComp.GetOperationClassByOpType(LOpTypeWord);
+ if Not Assigned(LOpClass) then Exit(False);
+ AOperation := LOpClass.Create(LOpProtocolVersion);
+ Try
+ If not AOperation.LoadFromStorage(AStream,CT_BUILD_PROTOCOL,Nil) then raise Exception.Create(Format('ERR 20211119-01 Cannot read %s from stream optype %d protocol %d',[ClassName,LOpTypeWord,LOpProtocolVersion]));
+ Result := True;
+ Except
+ On E:Exception do begin
+ FreeAndNil(AOperation);
+ Result := False;
+ end;
+ end;
+end;
+
destructor TPCOperation.Destroy;
begin
inherited Destroy;
@@ -3284,6 +4034,9 @@ procedure TPCOperation.InitializeData(AProtocolVersion : Word);
FUsedPubkeyForSignature:=CT_TECDSA_Public_Nul;
FBufferedSha256 := Nil;
FBufferedRipeMD160 := Nil;
+ FDiscoveredOnBlock := 0;
+ FResendOnBlock := 0;
+ FResendCount := 0;
end;
procedure TPCOperation.FillOperationResume(Block: Cardinal; getInfoForAllAccounts : Boolean; Affected_account_number: Cardinal; var OperationResume: TOperationResume);
@@ -3293,6 +4046,7 @@ procedure TPCOperation.FillOperationResume(Block: Cardinal; getInfoForAllAccount
function TPCOperation.IsValidECDSASignature(const PubKey: TECDSA_Public; const Signature: TECDSA_SIG): Boolean;
begin
+ {$IFnDEF TESTING_NO_POW_CHECK}
// Will reuse FHasValidSignature if checked previously and was True
// Introduced on Build 4.0.2 to increase speed using MEMPOOL verified operations instead of verify again everytime
if (FHasValidSignature) then begin
@@ -3309,6 +4063,11 @@ function TPCOperation.IsValidECDSASignature(const PubKey: TECDSA_Public; const S
end;
end;
Result := FHasValidSignature;
+ {$ELSE}
+ FHasValidSignature := True;
+ FUsedPubkeyForSignature := PubKey;
+ Result := True;
+ {$ENDIF}
end;
procedure TPCOperation.CopyUsedPubkeySignatureFrom(SourceOperation: TPCOperation);
@@ -3666,7 +4425,7 @@ function TPCOperation.RipeMD160: TRawBytes;
If Length(FBufferedRipeMD160)=0 then begin
FBufferedRipeMD160 := TCrypto.DoRipeMD160AsRaw(GetBufferForOpHash(true));
end;
- Result := FBufferedRipeMD160;
+ Result := Copy(FBufferedRipeMD160); // Fixed bug. TBytes must be copied using Copy instead of direct assignement.
end;
function TPCOperation.IsSignerAccount(account: Cardinal): Boolean;
@@ -3675,9 +4434,9 @@ function TPCOperation.IsSignerAccount(account: Cardinal): Boolean;
end;
function TPCOperation.IsAffectedAccount(account: Cardinal): Boolean;
-Var l : TList;
+Var l : TOrderedList;
begin
- l := TList.Create;
+ l := TOrderedList.Create(False,TComparison_Cardinal);
Try
AffectedAccounts(l);
Result := (l.IndexOf(account)>=0);
@@ -3725,84 +4484,6 @@ function TPCOperation.OperationAmountByAccount(account: Cardinal): Int64;
Result := 0;
end;
-{ TOperationsResumeList }
-
-Type POperationResume = ^TOperationResume;
-
-procedure TOperationsResumeList.Add(const OperationResume: TOperationResume);
-Var P : POperationResume;
-begin
- New(P);
- P^ := OperationResume;
- FList.Add(P);
-end;
-
-procedure TOperationsResumeList.Clear;
-Var P : POperationResume;
- i : Integer;
- l : TList;
-begin
- l := FList.LockList;
- try
- for i := 0 to l.Count - 1 do begin
- P := l[i];
- Dispose(P);
- end;
- l.Clear;
- finally
- FList.UnlockList;
- end;
-end;
-
-function TOperationsResumeList.Count: Integer;
-Var l : TList;
-begin
- l := FList.LockList;
- Try
- Result := l.Count;
- Finally
- FList.UnlockList;
- End;
-end;
-
-constructor TOperationsResumeList.Create;
-begin
- FList := TPCThreadList.Create('TOperationsResumeList_List');
-end;
-
-procedure TOperationsResumeList.Delete(index: Integer);
-Var P : POperationResume;
- l : TList;
-begin
- l := FList.LockList;
- Try
- P := l[index];
- l.Delete(index);
- Dispose(P);
- Finally
- FList.UnlockList;
- End;
-end;
-
-destructor TOperationsResumeList.Destroy;
-begin
- Clear;
- FreeAndNil(FList);
- inherited;
-end;
-
-function TOperationsResumeList.GetOperationResume(index: Integer): TOperationResume;
-Var l : TList;
-begin
- l := FList.LockList;
- try
- if index0) then begin
- LLastHeader := GetSafeboxChunkHeader(Count-1);
- if (LsbHeader.ContainsFirstBlock)
- or (LsbHeader.startBlock<>LLastHeader.endBlock+1)
- or (LLastHeader.ContainsLastBlock)
- or (LsbHeader.protocol<>LLastHeader.protocol)
- or (LsbHeader.blocksCount<>LLastHeader.blocksCount)
- or (Not LsbHeader.safeBoxHash.IsEqualTo( LLastHeader.safeBoxHash ))
- then begin
- raise EPCChunk.Create(Format('Cannot add %s at (%d) %s',[LsbHeader.ToString,Length(FChunks),LLastHeader.ToString]));
+ LCount := 0;
+ repeat
+ LChunk.streamInitialPosition := ASafeboxStreamChunk.position;
+ LChunk.stream := ASafeboxStreamChunk;
+ LChunk.freeStreamOnClear := AFreeStreamOnClear;
+ If Not TPCSafeBox.LoadSafeBoxStreamHeader(ASafeboxStreamChunk,LsbHeader,LChunk.streamFinalPosition) then begin
+ if (ARaiseOnError) and (LCount=0) then Raise EPCChunk.Create('SafeBoxStream is not a valid SafeBox to add!')
+ else Exit(LCount>0);
+ end else if LCount>0 then FIsMultiChunkStream := True;
+
+ if (Count>0) then begin
+ LLastHeader := GetSafeboxChunkHeader(Count-1);
+ if (LsbHeader.ContainsFirstBlock)
+ or (LsbHeader.startBlock<>LLastHeader.endBlock+1)
+ or (LLastHeader.ContainsLastBlock)
+ or (LsbHeader.protocol<>LLastHeader.protocol)
+ or (LsbHeader.blocksCount<>LLastHeader.blocksCount)
+ or (Not LsbHeader.safeBoxHash.IsEqualTo( LLastHeader.safeBoxHash ))
+ then begin
+ if ARaiseOnError then raise EPCChunk.Create(Format('Cannot add %s at (%d) %s',[LsbHeader.ToString,Length(FChunks),LLastHeader.ToString]))
+ else Exit(False);
+ end;
+ end else if (Not LsbHeader.ContainsFirstBlock) then begin
+ if ARaiseOnError then raise EPCChunk.Create(Format('Cannot add %s',[LsbHeader.ToString]))
+ else Exit(False);
end;
- end else if (Not LsbHeader.ContainsFirstBlock) then begin
- raise EPCChunk.Create(Format('Cannot add %s',[LsbHeader.ToString]));
- end;
- //
- SetLength(FChunks,Length(FChunks)+1);
- FChunks[High(FChunks)] := ASafeboxStreamChunk;
+ //
+ ASafeboxStreamChunk.Position := LChunk.streamFinalPosition;
+ //
+ SetLength(FChunks,Length(FChunks)+1);
+ FChunks[High(FChunks)] := LChunk;
+ inc(LCount);
+ until false;
+ Result := True;
end;
function TPCSafeboxChunks.GetSafeboxChunk(index: Integer): TStream;
begin
if (index<0) or (index>=Count) then raise EPCChunk.Create(Format('Invalid index %d of %d',[index,Length(FChunks)]));
- Result := FChunks[index];
- Result.Position := 0;
+ if FIsMultiChunkStream then begin
+ Result := FChunks[0].stream;
+ end else begin
+ Result := FChunks[index].stream;
+ end;
+ Result.Position := FChunks[index].streamInitialPosition;
end;
function TPCSafeboxChunks.GetSafeboxChunkHeader(index: Integer): TPCSafeBoxHeader;
@@ -146,6 +186,32 @@ function TPCSafeboxChunks.IsComplete: Boolean;
end;
end;
+function TPCSafeboxChunks.SaveSafeboxfile(AFileName: String): Boolean;
+var fs : TFileStream;
+begin
+ fs := TFileStream.Create(AFilename,fmCreate);
+ try
+ Result := SaveSafeboxStream(fs);
+ finally
+ fs.Free;
+ end;
+end;
+
+
+function TPCSafeboxChunks.SaveSafeboxStream(AStream: TStream): Boolean;
+Var
+ iChunk : Integer;
+ Lstream : TStream;
+begin
+ Result := false;
+ for iChunk := 0 to Count-1 do begin
+ Lstream := GetSafeboxChunk(iChunk);
+ AStream.CopyFrom(LStream,FChunks[iChunk].streamFinalPosition - FChunks[iChunk].streamInitialPosition);
+ end;
+ Result := True;
+end;
+
+
function TPCSafeboxChunks.GetSafeboxHeader: TPCSafeBoxHeader;
begin
if Not IsComplete then Raise EPCChunk.Create(Format('Chunks are not complete %d',[Length(FChunks)]));
@@ -153,6 +219,37 @@ function TPCSafeboxChunks.GetSafeboxHeader: TPCSafeBoxHeader;
Result.startBlock := 0;
end;
+class function TPCSafeboxChunks.GetSafeboxHeaderFromFile(AFilename: String;
+ var APCSafeBoxHeader: TPCSafeBoxHeader): Boolean;
+var fs: TFileStream;
+begin
+ APCSafeBoxHeader := CT_PCSafeBoxHeader_NUL;
+ if (AFileName.trim()='') or (Not FileExists(AFileName)) then Exit(False);
+ fs := TFileStream.Create(AFilename,fmOpenRead);
+ try
+ Result := TPCSafeboxChunks.GetSafeboxHeaderFromStream(fs,APCSafeBoxHeader);
+ finally
+ fs.Free;
+ end;
+end;
+
+class function TPCSafeboxChunks.GetSafeboxHeaderFromStream(AStream: TStream;
+ var APCSafeBoxHeader: TPCSafeBoxHeader): Boolean;
+var LChunks : TPCSafeboxChunks;
+begin
+ APCSafeBoxHeader := CT_PCSafeBoxHeader_NUL;
+ LChunks := TPCSafeboxChunks.Create;
+ try
+ if LChunks.AddChunk(AStream,False,False) then begin
+ if LChunks.IsComplete then APCSafeBoxHeader := LChunks.GetSafeboxHeader
+ else APCSafeBoxHeader := LChunks.GetSafeboxChunkHeader(0);
+ Result := True;
+ end else Result := False;
+ finally
+ LChunks.Free;
+ end;
+end;
+
{ TPCChunk }
class function TPCChunk.SaveSafeBoxChunkFromSafeBox(SafeBoxStream, DestStream : TStream; fromBlock, toBlock: Cardinal; var errors : String) : Boolean;
diff --git a/src/core/UConst.pas b/src/core/UConst.pas
index 08ca122c9..b69e25ca9 100644
--- a/src/core/UConst.pas
+++ b/src/core/UConst.pas
@@ -118,6 +118,8 @@ interface
CT_PROTOCOL_3 = 3;
CT_PROTOCOL_4 = 4;
CT_PROTOCOL_5 = 5;
+ CT_PROTOCOL_6 = 6;
+ CT_PROTOCOL_MAX = CT_PROTOCOL_6;
CT_BUILD_PROTOCOL = CT_PROTOCOL_5;
CT_BlockChain_Protocol_Available: Word = 5; // Protocol 5 flag
@@ -125,22 +127,24 @@ interface
CT_Protocol_Upgrade_v3_MinBlock = {$IFDEF PRODUCTION}210000{$ELSE}250{$ENDIF};
CT_Protocol_Upgrade_v4_MinBlock = {$IFDEF PRODUCTION}260000{$ELSE}400{$ENDIF};
CT_Protocol_Upgrade_v5_MinBlock = {$IFDEF PRODUCTION}378000{$ELSE}500{$ENDIF};
+ CT_Protocol_Upgrade_v6_MinBlock = {$IFDEF PRODUCTION}999999999{$ELSE}999999999{$ENDIF}; // TODO: ALLOW V6 activate setting a valid "min block" value
- CT_MagicNetIdentification = {$IFDEF PRODUCTION}$0A043580{$ELSE}$05000004{$ENDIF};
+ CT_MagicNetIdentification = {$IFDEF PRODUCTION}$0A043580{$ELSE}$05000005{$ENDIF};
- CT_NetProtocol_Version: Word = 10;
+ CT_NetProtocol_Version: Word = 14;
// IMPORTANT NOTE!!!
// NetProtocol_Available MUST BE always >= NetProtocol_version
- CT_NetProtocol_Available: Word = {$IFDEF PRODUCTION}12{$ELSE}12{$ENDIF};
+ CT_NetProtocol_Available: Word = {$IFDEF PRODUCTION}15{$ELSE}15{$ENDIF};
CT_MaxAccountOperationsPerBlockWithoutFee = 1;
+ CT_AllowPropagate0feeOperations = False;
CT_SafeBoxBankVersion : Word = 3; // Protocol 2 upgraded safebox version from 2 to 3
- CT_MagicIdentificator: String = {$IFDEF PRODUCTION}'PascalCoin'{$ELSE}'PascalCoinTESTNET_5.Beta.4'{$ENDIF}; //
+ CT_MagicIdentificator: String = {$IFDEF PRODUCTION}'PascalCoin'{$ELSE}'PascalCoin_TESTNET'{$ENDIF}; //
- CT_PascalCoin_Data_Folder : String = {$IFDEF PRODUCTION}'PascalCoin'{$ELSE}'PascalCoin_TESTNET_5.Beta.4'{$ENDIF}; //
+ CT_PascalCoin_Data_Folder : String = {$IFDEF PRODUCTION}'PascalCoin'{$ELSE}'PascalCoin_TESTNET'{$ENDIF}; //
CT_PseudoOp_Reward = $0;
// Value of Operations type in Protocol 1
@@ -195,7 +199,7 @@ interface
CT_OpSubtype_Data_Signer = 103;
CT_OpSubtype_Data_Receiver = 104;
- CT_ClientAppVersion : String = {$IFDEF PRODUCTION}'5.4.beta'{$ELSE}{$IFDEF TESTNET}'TESTNET 5.4.beta'{$ELSE}{$ENDIF}{$ENDIF};
+ CT_ClientAppVersion : String = {$IFDEF PRODUCTION}'5.8'{$ELSE}{$IFDEF TESTNET}'TESTNET 5.8'{$ELSE}{$ENDIF}{$ENDIF};
CT_Discover_IPs = {$IFDEF PRODUCTION}'bpascal1.dynamic-dns.net;bpascal2.dynamic-dns.net;pascalcoin1.dynamic-dns.net;pascalcoin2.dynamic-dns.net;pascalcoin1.dns1.us;pascalcoin2.dns1.us;pascalcoin1.dns2.us;pascalcoin2.dns2.us'
{$ELSE}'pascaltestnet1.dynamic-dns.net;pascaltestnet2.dynamic-dns.net;pascaltestnet1.dns1.us;pascaltestnet2.dns1.us'{$ENDIF};
@@ -214,8 +218,14 @@ interface
CT_MOLINA = 1;
CT_MOLINA_DECIMAL = {$IFDEF FPC}Real(CT_MOLINA/1000.0);{$ELSE}0.0001;{$ENDIF}
+ CT_DEFAULT_PAY_TO_KEY_MAX_MOLINAS = 5000;
+
CT_ACTIVATE_RANDOMHASH_V4 = {$IFDEF ACTIVATE_RANDOMHASH_V4}True{$ELSE}False{$ENDIF};
+ // Represents a non-existent account number
+ // (chosen as the last account in safebox, generated in year 6101)
+ CT_AccountNo_NUL = High(Cardinal);
+
// App Params
CT_PARAM_GridAccountsStream = 'GridAccountsStreamV2';
CT_PARAM_GridAccountsPos = 'GridAccountsPos';
diff --git a/src/core/UCrypto.pas b/src/core/UCrypto.pas
index 40226e4eb..883f23716 100644
--- a/src/core/UCrypto.pas
+++ b/src/core/UCrypto.pas
@@ -632,8 +632,9 @@ class procedure TCrypto.DoSha256(const TheMessage: TRawBytes; out ResultSha256:
begin
{$IFDEF Use_OpenSSL}
If length(ResultSha256)<>32 then SetLength(ResultSha256,32);
- PS := @ResultSha256[Low(ResultSha256)];
- SHA256(@TheMessage[Low(TheMessage)],Length(TheMessage),PS);
+ PS := @ResultSha256[0];
+ if length(TheMessage)=0 then SHA256(Nil,0,PS)
+ else SHA256(@TheMessage[0],Length(TheMessage),PS);
{$ELSE}
TPCCryptoLib4Pascal.DoSHA256(TheMessage,ResultSha256);
{$ENDIF}
diff --git a/src/core/UEPasa.pas b/src/core/UEPasa.pas
new file mode 100644
index 000000000..c44d6658c
--- /dev/null
+++ b/src/core/UEPasa.pas
@@ -0,0 +1,843 @@
+unit UEPasa;
+
+{ Copyright (c) 2020 by Herman Schoenfeld
+
+ PIP-0027: E-PASA Reference Implementation
+ See: https://github.com/PascalCoin/PascalCoin/blob/master/PIP/PIP-0027.md
+
+ Distributed under the MIT software license, see the accompanying file LICENSE
+ or visit http://www.opensource.org/licenses/mit-license.php.
+
+ This unit is a part of the PascalCoin Project, an infinitely scalable
+ cryptocurrency. Find us here:
+ Web: https://www.pascalcoin.org
+ Source: https://github.com/PascalCoin/PascalCoin
+
+ THIS LICENSE HEADER MUST NOT BE REMOVED.
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+ {$ZEROBASEDSTRINGS OFF}
+{$ENDIF FPC}
+
+interface
+
+uses
+ SysUtils,
+ TypInfo,
+ uregexpr,
+ UCommon,
+ UCrypto,
+ UEncoding,
+ SyncObjs;
+
+type
+
+ EPascalCoinException = class(Exception);
+
+ EPasaErrorCode = (
+ Success, BadFormat, BadChecksum, InvalidAccountNumber,
+ AccountChecksumInvalid, InvalidAccountName, MismatchedPayloadEncoding,
+ PayloadTooLarge, MissingPassword, UnusedPassword, InvalidPassword,
+ BadExtendedChecksum
+ );
+
+ { TPayloadTrait }
+
+ TPayloadTrait = (
+ ptNonDeterministic = 0, // Payload encryption and encoding method not specified.
+ ptPublic = 1, // Unencrypted, public payload.
+ ptRecipientKeyEncrypted = 2, // ECIES encrypted using recipient accounts public key.
+ ptSenderKeyEncrypted = 3, // ECIES encrypted using sender accounts public key.
+ ptPasswordEncrypted = 4, // AES encrypted using pwd param
+ ptAsciiFormatted = 5, // Payload data encoded in ASCII
+ ptHexFormatted = 6, // Payload data encoded in HEX
+ ptBase58Formatted = 7, // Payload data encoded in Base58
+ ptAddressedByName = 8 // E-PASA addressed by account name (not number).
+ );
+
+ { TPayloadTraitHelper }
+
+ TPayloadTraitHelper = record helper for TPayloadTrait
+ public
+ function ToProtocolValue: byte;
+ end;
+
+ { TPayloadType }
+
+ TPayloadType = set of TPayloadTrait;
+
+ { TPayloadTypesHelper }
+
+ TPayloadTypeHelper = record helper for TPayloadType
+ public
+ function HasTrait(APayloadTrait: TPayloadTrait): Boolean; inline;
+ function ToProtocolValue : byte;
+ function IsValid : Boolean;
+ end;
+
+ { TEPasa }
+
+
+ TEPasa = record
+ strict private var
+ FAccount, FAccountChecksum: TNullable;
+ FAccountName, FPayload, FPassword, FExtendedChecksum: String;
+ FPayloadType: TPayloadType;
+
+ function GetAccount: TNullable; inline;
+ procedure SetAccount(const AValue: TNullable); inline;
+ function GetAccountChecksum: TNullable; inline;
+ procedure SetAccountChecksum(const AValue: TNullable); inline;
+ function GetPayloadType: TPayloadType; inline;
+ function GetAccountName: String; inline;
+ procedure SetAccountName(const AValue: String); inline;
+ procedure SetPayloadType(const AValue: TPayloadType); inline;
+ function GetExtendedChecksum: String; inline;
+ procedure SetExtendedChecksum(const AValue: String); inline;
+ function GetPassword: String; inline;
+ procedure SetPassword(const AValue: String); inline;
+ function GetPayload: String; inline;
+ procedure SetPayload(const AValue: String); inline;
+ function GetHasPayload: Boolean; inline;
+ function GetIsStandard: Boolean; inline;
+ function GetIsPayToKey: Boolean; inline;
+ function GetIsAddressedByName : Boolean; inline;
+ function GetIsAddressedByNumber : Boolean; inline;
+ class function GetEmptyValue : TEPasa; static;
+ public
+ property Account: TNullable read GetAccount write SetAccount;
+ property AccountChecksum: TNullable read GetAccountChecksum write SetAccountChecksum;
+ property AccountName: String read GetAccountName write SetAccountName;
+ property PayloadType: TPayloadType read GetPayloadType write SetPayloadType;
+ property Payload: String read GetPayload write SetPayload;
+ property Password: String read GetPassword write SetPassword;
+ property ExtendedChecksum: String read GetExtendedChecksum write SetExtendedChecksum;
+ property IsAddressedByNumber: boolean read GetIsAddressedByNumber;
+ property IsAddressedByName: boolean read GetIsAddressedByName;
+ property IsPayToKey: boolean read GetIsPayToKey;
+ property IsClassicPASA: boolean read GetIsStandard;
+ property HasPayload: boolean read GetHasPayload;
+ class property Empty : TEPasa read GetEmptyValue;
+
+ function GetRawPayloadBytes(): TBytes; inline;
+
+ function ToClassicPASAString(): String; overload;
+ function ToString(): String; overload;
+ function ToString(AOmitExtendedChecksum: Boolean): String; overload;
+
+ class function TryParse(const AEPasaText: String; AOmitExtendedChecksumVerification : Boolean; out AEPasa: TEPasa) : Boolean; overload; static;
+ class function TryParse(const AEPasaText: String; out AEPasa: TEPasa) : Boolean; overload; static;
+ class function Parse(const AEPasaText: String): TEPasa; static;
+
+ class function CalculateAccountChecksum(AAccNo: UInt32): Byte; static; inline;
+ procedure Clear;
+ end;
+
+
+
+ { TEPasaParser }
+
+ TEPasaParser = class
+ strict private
+ class var FEPasaRegex: TCustomRegex;
+ class var FEPasaLocker : TCriticalSection;
+ class constructor CreateRegexEPasaParser();
+ class destructor DestroyRegexEPasaParser();
+
+ public
+ const
+ // note: regex syntax escapes following chars [\^$.|?*+(){}
+ // note: epasa syntax escapes following chars: :\"[]()<>(){}
+ // note: c-sharp syntax verbatim strings escape: " as ""
+ IntegerPattern = '(0|[1-9]\d*)';
+ AccountNamePattern = '(?P' + TPascal64Encoding.StringPattern + ')';
+ AccountChecksumPattern = '(?:(?P-)(?P\d{2}))?';
+ AccountNumberPattern = '(?P' + IntegerPattern + ')' + AccountChecksumPattern;
+ PasaPattern = '(' + AccountNumberPattern + '|' + AccountNamePattern + ')';
+ ASCIIContentPattern = '"' + TPascalAsciiEncoding.StringPattern + '"';
+ HexContentPattern = '0x' + THexEncoding.SubStringPattern;
+ Base58ContentPattern = TPascalBase58Encoding.SubStringPattern;
+ PayloadPasswordPattern = '(?:(?P' + ':){1}(?P' + TPascalAsciiEncoding.StringPattern + ')?)?';
+ PayloadStartCharPattern = '(?P[\[\(<\{])';
+ PayloadEndCharPattern = '(?P[]\)>\}])';
+ PayloadContentPattern = '(?P' + ASCIIContentPattern + '|' + HexContentPattern + '|' + Base58ContentPattern + ')?';
+ PayloadPattern = '(?:' + PayloadStartCharPattern + PayloadContentPattern + PayloadPasswordPattern + PayloadEndCharPattern + ')?';
+ ExtendedChecksumPattern = '(?:' + '(?P:)' + '(?P' + THexEncoding.BytePattern + THexEncoding.BytePattern + '))?';
+ EPasaPattern = PasaPattern + PayloadPattern + ExtendedChecksumPattern;
+
+ function Parse(const AEPasaText: String): TEPasa;
+ function TryParse(const AEPasaText: String; out AEPasa: TEPasa): Boolean; overload;
+ function TryParse(const AEPasaText: String; out AEPasa: TEPasa; out AErrorCode: EPasaErrorCode): Boolean; overload;
+ function TryParse(const AEPasaText: String; AOmitExtendedChecksumVerification : Boolean; out AEPasa: TEPasa; out AErrorCode: EPasaErrorCode): Boolean; overload;
+ end;
+
+ { TEPasaComp }
+
+ TEPasaComp = class sealed(TObject)
+
+ strict private
+ class function ReadUInt16AsBytesLE(AValue: UInt16): TArray; static;
+
+ public
+ const
+ MaxPublicAsciiContentLength: Int32 = 255;
+ MaxECIESAsciiContentLength: Int32 = 144;
+ MaxAESAsciiContentLength: Int32 = 223;
+ MaxPublicHexContentLength: Int32 = 510 + 2;
+ MaxECIESHexContentLength: Int32 = 288 + 2;
+ MaxAESHexContentLength: Int32 = 446 + 2;
+ MaxPublicBase58ContentLength: Int32 = 348;
+ MaxECIESBase58ContentLength: Int32 = 196;
+ MaxAESBase58ContentLength: Int32 = 304;
+ ExtendedChecksumMurMur3Seed: UInt32 = 0;
+
+ class function ComputeExtendedChecksum(const AText: String): String; static;
+ class function IsValidExtendedChecksum(const AText: String; const AChecksum: String): Boolean; static;
+ class function IsValidPayloadLength(APayloadType: TPayloadType; const APayloadContent: String): Boolean; static;
+ class function IsValidPasswordLength(const APasswordValue: String) : Boolean; static;
+
+ class function GetPayloadTypeProtocolByte(const APayloadType : TPayloadType) : Byte;
+ class function GetPayloadTypeFromProtocolByte(AByte : Byte) : TPayloadType;
+ class function FromProtocolValue(AVal : Byte) : TPayloadType;
+ end;
+
+resourcestring
+ SUnknownPayloadEncoding = 'Unknown payload encoding.';
+ SInvalidEPasaFormat = 'Invalid E-PASA format, %s';
+ SInvalidEPasa = 'Invalid EPASA "%s": %s';
+ SInvalidHexString = 'Invalid hex-formatted string, %s';
+ SInvalidBase58String = 'Invalid Base58-formatted string, %s';
+ SBase58EncodeError = 'Error Encoding to Base58';
+ SUnRecognizedStartCharacter = 'Unrecognized start character, %s';
+ SInvalidPASCQuantity = 'Invalid PASC quantity string, %s';
+
+implementation
+
+uses
+ HlpHashFactory,
+ HlpIHashInfo,
+ HlpConverters,
+ UMemory;
+
+var
+ EmptyEPasa : TEPasa;
+
+{ TPayloadTraitHelper }
+
+function TPayloadTraitHelper.ToProtocolValue: Byte;
+begin
+ case Self of
+ ptNonDeterministic: Exit(0);
+ ptPublic: Exit(BYTE_BIT_0);
+ ptRecipientKeyEncrypted: Exit(BYTE_BIT_1);
+ ptSenderKeyEncrypted: Exit(BYTE_BIT_2);
+ ptPasswordEncrypted: Exit(BYTE_BIT_3);
+ ptAsciiFormatted: Exit(BYTE_BIT_4);
+ ptHexFormatted: Exit(BYTE_BIT_5);
+ ptBase58Formatted: Exit(BYTE_BIT_6);
+ ptAddressedByName: Exit(BYTE_BIT_7);
+ end;
+ raise Exception.Create('Internal Error 2faed11a-1b0f-447a-87d1-2e1735ac4ca2');
+end;
+
+{ TPayloadTypeHelper }
+
+function TPayloadTypeHelper.HasTrait(APayloadTrait : TPayloadTrait) : Boolean;
+begin
+ Result := APayloadTrait in Self;
+end;
+
+function TPayloadTypeHelper.IsValid: Boolean;
+var LValue, LEncryptedBits, LFormattedBits : Byte;
+begin
+ { As described on PIP-0027 E-PASA:
+ Bits 0..3 describe how payload is encrypted. 1 option (and only 1) must be selected
+ Bits 4..6 describe how is data encoded: String, Hexa or Base58. 1 option (and 1 only 1) must be selected
+
+ IsValid = 1 bit from 0..3 and 1 bit from 4..6 must be selected
+ }
+ LValue := Self.ToProtocolValue;
+ LEncryptedBits := (LValue and $0F); // 0000 1111
+ LFormattedBits := (LValue and $70); // 0111 0000
+ Result :=
+ (
+ ((LEncryptedBits and BYTE_BIT_0)=BYTE_BIT_0)
+ or ((LEncryptedBits and BYTE_BIT_1)=BYTE_BIT_1)
+ or ((LEncryptedBits and BYTE_BIT_2)=BYTE_BIT_2)
+ or ((LEncryptedBits and BYTE_BIT_3)=BYTE_BIT_3)
+ )
+ and
+ (
+ ((LFormattedBits and BYTE_BIT_4)=BYTE_BIT_4)
+ or ((LFormattedBits and BYTE_BIT_5)=BYTE_BIT_5)
+ or ((LFormattedBits and BYTE_BIT_6)=BYTE_BIT_6)
+ );
+end;
+
+function TPayloadTypeHelper.ToProtocolValue : Byte;
+begin
+ Result := TEPasaComp.GetPayloadTypeProtocolByte(Self);
+end;
+
+{ TEPasa }
+
+procedure TEPasa.Clear;
+begin
+ Self.FAccount.Clear;
+ Self.FAccountChecksum.Clear;
+ Self.FAccountName:='';
+ Self.FPayload:='';
+ Self.FPassword:='';
+ Self.FExtendedChecksum:='';
+ Self.FPayloadType:=[];
+end;
+
+function TEPasa.GetAccount: TNullable;
+begin
+ Result := FAccount;
+end;
+
+function TEPasa.GetAccountChecksum: TNullable;
+begin
+ Result := FAccountChecksum;
+end;
+
+function TEPasa.GetAccountName: String;
+begin
+ Result := FAccountName;
+end;
+
+function TEPasa.GetExtendedChecksum: String;
+begin
+ Result := FExtendedChecksum;
+end;
+
+function TEPasa.GetPassword: String;
+begin
+ Result := FPassword;
+end;
+
+function TEPasa.GetPayload: String;
+begin
+ Result := FPayload;
+end;
+
+function TEPasa.GetPayloadType: TPayloadType;
+begin
+ Result := FPayloadType;
+end;
+
+procedure TEPasa.SetAccount(const AValue: TNullable);
+begin
+ FAccount := AValue;
+end;
+
+procedure TEPasa.SetAccountChecksum(const AValue: TNullable);
+begin
+ FAccountChecksum := AValue;
+end;
+
+procedure TEPasa.SetAccountName(const AValue: String);
+begin
+ FAccountName := AValue;
+end;
+
+procedure TEPasa.SetExtendedChecksum(const AValue: String);
+begin
+ FExtendedChecksum := AValue;
+end;
+
+procedure TEPasa.SetPassword(const AValue: String);
+begin
+ FPassword := AValue;
+end;
+
+procedure TEPasa.SetPayload(const AValue: String);
+begin
+ FPayload := AValue;
+end;
+
+procedure TEPasa.SetPayloadType(const AValue: TPayloadType);
+begin
+ FPayloadType := AValue;
+end;
+
+function TEPasa.GetIsAddressedByNumber : Boolean;
+begin
+ Result := NOT PayloadType.HasTrait(ptAddressedByName);
+end;
+
+function TEPasa.GetIsAddressedByName : Boolean;
+begin
+ Result := (NOT IsPayToKey) AND PayloadType.HasTrait(ptAddressedByName);
+end;
+
+function TEPasa.GetIsPayToKey: Boolean;
+begin
+ Result :=
+ (AccountName = '@') and
+ (PayloadType.HasTrait(ptAddressedByName) and
+ PayloadType.HasTrait(ptPublic) and
+ PayloadType.HasTrait(ptBase58Formatted));
+end;
+
+function TEPasa.GetIsStandard: Boolean;
+begin
+ Result := (NOT PayloadType.HasTrait(ptAddressedByName)) AND (NOT HasPayload);
+end;
+
+function TEPasa.GetHasPayload: Boolean;
+begin
+ Result := PayloadType.HasTrait(ptPublic) OR PayloadType.HasTrait(ptRecipientKeyEncrypted) OR PayloadType.HasTrait(ptSenderKeyEncrypted);
+end;
+
+function TEPasa.GetRawPayloadBytes: TBytes;
+begin
+ if (PayloadType.HasTrait(ptAsciiFormatted)) then
+ Exit(TEncoding.ASCII.GetBytes(Payload));
+
+ if (PayloadType.HasTrait(ptBase58Formatted)) then
+ Exit(TPascalBase58Encoding.Decode(Payload));
+
+ if (PayloadType.HasTrait(ptHexFormatted)) then
+ Exit(THexEncoding.Decode(Payload));
+
+ raise EPascalCoinException.CreateRes(@SUnknownPayloadEncoding);
+end;
+
+function TEPasa.ToClassicPASAString : String;
+begin
+ Result := ToString(True);
+end;
+
+function TEPasa.ToString: String;
+begin
+ Result := ToString(False);
+end;
+
+function TEPasa.ToString(AOmitExtendedChecksum: Boolean): String;
+var
+ LPayloadContent: String;
+begin
+ Result := string.Empty;
+ if PayloadType.HasTrait(ptNonDeterministic) then Exit;
+
+ if (PayloadType.HasTrait(ptAddressedByName)) then begin
+ Result := Result + TPascal64Encoding.Escape(AccountName);
+ end else begin
+ if (Not Account.HasValue) then Exit;
+ Result := Result + Account.Value.ToString();
+ if (AccountChecksum.HasValue) then begin
+ Result := Result + String.Format('-%u', [AccountChecksum.Value]);
+ end;
+ end;
+
+ if (PayloadType.HasTrait(ptAsciiFormatted)) then begin
+ LPayloadContent := String.Format('"%s"', [TPascalAsciiEncoding.Escape(Payload)]);
+ end else if (PayloadType.HasTrait(ptHexFormatted)) then begin
+ LPayloadContent := string.Format('0x%s', [Payload]);
+ end else if (PayloadType.HasTrait(ptBase58Formatted)) then begin
+ LPayloadContent := string.Format('%s', [Payload]);
+ end else begin
+ // it is non-deterministic, so payload content is ignored
+ LPayloadContent := string.Empty;
+ end;
+
+ if (PayloadType.HasTrait(ptPublic)) then begin
+ Result := Result + string.Format('[%s]', [LPayloadContent]);
+ end else if (PayloadType.HasTrait(ptRecipientKeyEncrypted)) then begin
+ Result := Result + string.Format('(%s)', [LPayloadContent]);
+ end else if (PayloadType.HasTrait(ptSenderKeyEncrypted)) then begin
+ Result := Result + string.Format('<%s>', [LPayloadContent]);
+ end else if (PayloadType.HasTrait(ptPasswordEncrypted)) then begin
+ Result := Result + string.Format('{%s:%s}', [LPayloadContent, TPascalAsciiEncoding.Escape(Password)]);
+ end else begin
+ // it is non-deterministic, so payload omitted entirely
+ end;
+
+ if (not AOmitExtendedChecksum) then begin
+ if (ExtendedChecksum='') then begin
+ // Need to compute:
+ ExtendedChecksum := TEPasaComp.ComputeExtendedChecksum(Result);
+ end;
+ Result := Result + string.Format(':%s', [ExtendedChecksum]);
+ end;
+end;
+
+
+
+class function TEPasa.TryParse(const AEPasaText: String; out AEPasa: TEPasa): Boolean;
+begin
+ Result := TryParse(AEPasaText,False,AEPasa);
+end;
+
+class function TEPasa.TryParse(const AEPasaText: String; AOmitExtendedChecksumVerification: Boolean; out AEPasa: TEPasa): Boolean;
+var
+ LParser: TEPasaParser;
+ LDisposables : TDisposables;
+ LEPasaErrorCode : EPasaErrorCode;
+begin
+ LParser := LDisposables.AddObject( TEPasaParser.Create() ) as TEPasaParser;
+ Result := LParser.TryParse(AEPasaText,AOmitExtendedChecksumVerification,AEPasa,LEPasaErrorCode);
+end;
+
+class function TEPasa.Parse(const AEPasaText: String): TEPasa;
+begin
+ if (TryParse(AEPasaText, Result)) then
+ Exit(Result);
+ raise EArgumentException.CreateResFmt(@SInvalidEPasaFormat, ['AEPasaText']);
+end;
+
+class function TEPasa.CalculateAccountChecksum(AAccNo: UInt32): Byte;
+begin
+ Result := Byte(((UInt64(AAccNo) * 101) mod 89) + 10);
+end;
+
+
+class function TEPasa.GetEmptyValue : TEPasa;
+begin
+ Result := EmptyEPasa;
+end;
+
+{ TEPasaParser }
+
+class constructor TEPasaParser.CreateRegexEPasaParser;
+begin
+ FEPasaRegex := TCustomRegex.Create(EPasaPattern);
+ FEPasaLocker := TCriticalSection.Create;
+end;
+
+class destructor TEPasaParser.DestroyRegexEPasaParser;
+begin
+ FEPasaRegex.Free;
+ FEPasaLocker.Free;
+end;
+
+function TEPasaParser.Parse(const AEPasaText: String): TEPasa;
+var
+ LErrorCode: EPasaErrorCode;
+begin
+ if (not TryParse(AEPasaText, Result, LErrorCode)) then
+ raise EArgumentException.CreateResFmt(@SInvalidEPasa,
+ ['AEPasaText', GetEnumName(TypeInfo(EPasaErrorCode), Ord(LErrorCode))]);
+ Exit(Result);
+end;
+
+function TEPasaParser.TryParse(const AEPasaText: String; out AEPasa: TEPasa): Boolean;
+var
+ LErrorCode: EPasaErrorCode;
+begin
+ Result := TryParse(AEPasaText, AEPasa, LErrorCode);
+end;
+
+function TEPasaParser.TryParse(const AEPasaText: String; out AEPasa: TEPasa; out AErrorCode: EPasaErrorCode): Boolean;
+begin
+ Result := TryParse(AEPasaText,False,AEPasa,AErrorCode);
+end;
+
+function TEPasaParser.TryParse(const AEPasaText: String; AOmitExtendedChecksumVerification: Boolean; out AEPasa: TEPasa; out AErrorCode: EPasaErrorCode): Boolean;
+var
+ LChecksumDelim, LAccountNumber, LAccountChecksum, LAccountName, LPayloadStartChar,
+ LPayloadEndChar, LPayloadContent, LPayloadPasswordDelim, LPayloadPassword,
+ LExtendedChecksumDelim, LExtendedChecksum, LActualChecksum: String;
+ LAccNo, LAccChecksum: UInt32;
+ LActualAccountChecksum: Byte;
+begin
+ AErrorCode := EPasaErrorCode.Success;
+ AEPasa.Clear;
+ if (string.IsNullOrEmpty(AEPasaText)) then begin
+ AErrorCode := EPasaErrorCode.BadFormat;
+ Exit(False);
+ end;
+
+ FEPasaLocker.Acquire; // Protect against multithread
+ Try
+
+ FEPasaRegex.Match(AEPasaText);
+
+ LChecksumDelim := FEPasaRegex.GetMatchFromName('ChecksumDelim');
+ LAccountNumber := FEPasaRegex.GetMatchFromName('AccountNumber');
+ LAccountChecksum := FEPasaRegex.GetMatchFromName('Checksum');
+ LAccountName := FEPasaRegex.GetMatchFromName('AccountName');
+ LPayloadStartChar := FEPasaRegex.GetMatchFromName('PayloadStartChar');
+ LPayloadEndChar := FEPasaRegex.GetMatchFromName('PayloadEndChar');
+ LPayloadContent := FEPasaRegex.GetMatchFromName('PayloadContent');
+ LPayloadPasswordDelim := FEPasaRegex.GetMatchFromName('PayloadPasswordDelim');
+ LPayloadPassword := FEPasaRegex.GetMatchFromName('PayloadPassword');
+ LExtendedChecksumDelim := FEPasaRegex.GetMatchFromName('ExtendedChecksumDelim');
+ LExtendedChecksum := FEPasaRegex.GetMatchFromName('ExtendedChecksum');
+
+ // Check parsed completely
+ if (AEPasaText <> FEPasaRegex.Value) then begin
+ AErrorCode := EPasaErrorCode.BadFormat;
+ Exit(False);
+ end;
+
+ Finally
+ FEPasaLocker.Release;
+ End;
+
+ if (LAccountName <> #0) then begin
+ // Account Name
+ if (string.IsNullOrEmpty(LAccountName)) then begin
+ AErrorCode := EPasaErrorCode.BadFormat;
+ Exit(False);
+ end;
+
+ // KeyNote
+ // when multiple enums are OR'ed in C#, they are combined and
+ // if any of the enums numeric value is zero, it is excluded.
+ // in our case,"PayloadType.NonDeterministic" is always zero so we exclude it from our set.
+ AEPasa.PayloadType := AEPasa.PayloadType + [ptAddressedByName] -[ptNonDeterministic];
+ AEPasa.AccountName := TPascal64Encoding.Unescape(LAccountName);
+ AEPasa.Account := Nil;
+ AEPasa.AccountChecksum := Nil;
+ end else begin
+ // Account Number
+ if (not UInt32.TryParse(LAccountNumber, LAccNo)) then begin
+ AErrorCode := EPasaErrorCode.InvalidAccountNumber;
+ Exit(False);
+ end;
+ AEPasa.Account := LAccNo;
+ LActualAccountChecksum := TEPasa.CalculateAccountChecksum(LAccNo);
+
+ if (LChecksumDelim <> #0) then begin
+ // validate account checksum
+ if (not UInt32.TryParse(LAccountChecksum, LAccChecksum)) then begin
+ AErrorCode := EPasaErrorCode.AccountChecksumInvalid;
+ Exit(False);
+ end;
+ if (LAccChecksum <> LActualAccountChecksum) then begin
+ AErrorCode := EPasaErrorCode.BadChecksum;
+ Exit(False);
+ end;
+ end;
+
+ AEPasa.AccountChecksum := LActualAccountChecksum;
+ end;
+
+ // Encryption type
+ case LPayloadStartChar[1] of
+ #0: begin
+ // do nothing
+ end;
+ '[': begin
+ if (LPayloadEndChar <> ']') then begin
+ AErrorCode := EPasaErrorCode.MismatchedPayloadEncoding;
+ Exit(False);
+ end;
+ AEPasa.PayloadType := AEPasa.PayloadType + [ptPublic] -
+ [ptNonDeterministic];
+ end;
+ '(': begin
+ if (LPayloadEndChar <> ')') then begin
+ AErrorCode := EPasaErrorCode.MismatchedPayloadEncoding;
+ Exit(False);
+ end;
+ AEPasa.PayloadType := AEPasa.PayloadType + [ptRecipientKeyEncrypted] - [ptNonDeterministic];
+ end;
+ '<': begin
+ if (LPayloadEndChar <> '>') then begin
+ AErrorCode := EPasaErrorCode.MismatchedPayloadEncoding;
+ Exit(False);
+ end;
+ AEPasa.PayloadType := AEPasa.PayloadType +
+ [ptSenderKeyEncrypted] - [ptNonDeterministic];
+ end;
+
+ '{': begin
+ if (LPayloadEndChar <> '}') then begin
+ AErrorCode := EPasaErrorCode.MismatchedPayloadEncoding;
+ Exit(False);
+ end;
+ AEPasa.PayloadType := AEPasa.PayloadType + [ptPasswordEncrypted] - [ptNonDeterministic];
+ end
+ else raise ENotSupportedException.CreateResFmt(@SUnRecognizedStartCharacter, [LPayloadStartChar]);
+ end;
+
+ // Password
+ if (AEPasa.PayloadType.HasTrait(ptPasswordEncrypted)) then begin
+ if (LPayloadPasswordDelim = #0) then begin
+ AErrorCode := EPasaErrorCode.MissingPassword;
+ Exit(False);
+ end;
+
+ AEPasa.Password := TPascalAsciiEncoding.UnEscape(IIF(LPayloadPassword = #0, '', LPayloadPassword));
+ end else if (LPayloadPasswordDelim <> #0) then begin
+ AErrorCode := EPasaErrorCode.UnusedPassword;
+ Exit(False);
+ end;
+
+ // Payload
+ if (LPayloadStartChar <> #0) then begin
+ if (LPayloadContent = #0) then begin
+ AEPasa.Payload := string.Empty;
+ end else if (LPayloadContent.StartsWith('"')) then begin
+ AEPasa.PayloadType := AEPasa.PayloadType + [ptAsciiFormatted] - [ptNonDeterministic];
+ AEPasa.Payload := TPascalAsciiEncoding.UnEscape(LPayloadContent.Trim(['"']));
+ end else if (LPayloadContent.StartsWith('0x')) then begin
+ AEPasa.PayloadType := AEPasa.PayloadType + [ptHexFormatted] - [ptNonDeterministic];
+ AEPasa.Payload := System.Copy(LPayloadContent, 3, LPayloadContent.Length - 2);
+ end else begin
+ AEPasa.PayloadType := AEPasa.PayloadType + [ptBase58Formatted] - [ptNonDeterministic];
+ AEPasa.Payload := LPayloadContent;
+ end;
+ end;
+
+ // Payload Lengths
+ if (not TEPasaComp.IsValidPayloadLength(AEPasa.PayloadType, AEPasa.Payload)) then begin
+ AErrorCode := EPasaErrorCode.PayloadTooLarge;
+ Exit(False);
+ end;
+
+ // Extended Checksum
+ LActualChecksum := TEPasaComp.ComputeExtendedChecksum(AEPasa.ToString(True));
+ if (LExtendedChecksumDelim <> #0) then begin
+ if (LExtendedChecksum <> LActualChecksum) and (Not AOmitExtendedChecksumVerification) then begin
+ AErrorCode := EPasaErrorCode.BadExtendedChecksum;
+ Exit(False);
+ end;
+ end;
+ AEPasa.ExtendedChecksum := LActualChecksum;
+
+ Result := True;
+end;
+
+
+{ TEPasaComp }
+
+class function TEPasaComp.ReadUInt16AsBytesLE(AValue: UInt16): TArray;
+begin
+ System.SetLength(Result, System.SizeOf(UInt16));
+ Result[0] := Byte(AValue);
+ Result[1] := Byte(AValue shr 8);
+end;
+
+class function TEPasaComp.ComputeExtendedChecksum(const AText: String): String;
+var
+ LHashInstance: IHashWithKey;
+ LChecksum: UInt16;
+begin
+ LHashInstance := THashFactory.THash32.CreateMurmurHash3_x86_32();
+ LHashInstance.Key := TConverters.ReadUInt32AsBytesLE(ExtendedChecksumMurMur3Seed);
+ LChecksum := UInt16(LHashInstance.ComputeBytes(TEncoding.ASCII.GetBytes(AText)).GetUInt32() mod 65536);
+ Result := THexEncoding.Encode(ReadUInt16AsBytesLE(LChecksum), True);
+end;
+
+class function TEPasaComp.IsValidExtendedChecksum(const AText, AChecksum: String): Boolean;
+begin
+ Result := ComputeExtendedChecksum(AText) = AChecksum;
+end;
+
+class function TEPasaComp.IsValidPayloadLength(APayloadType: TPayloadType; const APayloadContent: String): Boolean;
+begin
+ if (string.IsNullOrEmpty(APayloadContent)) then
+ Exit(True);
+
+ if (APayloadType.HasTrait(ptPublic)) then begin
+
+ if (APayloadType.HasTrait(ptAsciiFormatted)) then
+ Exit(TPascalAsciiEncoding.UnEscape(APayloadContent).Length <= MaxPublicAsciiContentLength);
+
+ if (APayloadType.HasTrait(ptHexFormatted)) then
+ Exit(APayloadContent.Length <= MaxPublicHexContentLength);
+
+ if (APayloadType.HasTrait(ptBase58Formatted)) then
+ Exit(APayloadContent.Length <= MaxPublicBase58ContentLength);
+
+ // unknown encoding format
+ Result := False;
+ end;
+
+ if (APayloadType.HasTrait(ptSenderKeyEncrypted) or APayloadType.HasTrait(ptRecipientKeyEncrypted)) then begin
+
+ if (APayloadType.HasTrait(ptAsciiFormatted)) then
+ Exit(TPascalAsciiEncoding.UnEscape(APayloadContent).Length <= MaxECIESAsciiContentLength);
+
+ if (APayloadType.HasTrait(ptHexFormatted)) then
+ Exit(APayloadContent.Length <= MaxECIESHexContentLength);
+
+ if (APayloadType.HasTrait(ptBase58Formatted)) then
+ Exit(APayloadContent.Length <= MaxECIESBase58ContentLength);
+ // unknown encoding format
+ Result := False;
+ end;
+
+ if (APayloadType.HasTrait(ptPasswordEncrypted)) then begin
+ if (APayloadType.HasTrait(ptAsciiFormatted)) then
+ Exit(TPascalAsciiEncoding.UnEscape(APayloadContent).Length <= MaxAESAsciiContentLength);
+
+ if (APayloadType.HasTrait(ptHexFormatted)) then
+ Exit(APayloadContent.Length <= MaxAESHexContentLength);
+
+ if (APayloadType.HasTrait(ptBase58Formatted)) then
+ Exit(APayloadContent.Length <= MaxAESBase58ContentLength);
+
+ // unknown encoding format
+ Result := False;
+ end;
+
+ // unknown encryption format
+ Result := False;
+end;
+
+class function TEPasaComp.IsValidPasswordLength(const APasswordValue : String): Boolean;
+begin
+ // no password length policy established (only client-side concern)
+ Result := True;
+end;
+
+class function TEPasaComp.GetPayloadTypeProtocolByte(const APayloadType : TPayloadType) : Byte;
+var
+ LPayloadType : TPayloadTrait;
+begin
+ Result := 0; // NonDeterministic by default
+ for LPayloadType := Low(TPayloadTrait) to High(TPayloadTrait) do
+ if APayloadType.HasTrait(LPayloadType) then
+ Result := Result OR LPayloadType.ToProtocolValue;
+end;
+
+class function TEPasaComp.GetPayloadTypeFromProtocolByte(AByte: Byte) : TPayloadType;
+var
+ LPayloadType : TPayloadTrait;
+ LPayloadTypeByte : byte;
+begin
+ if AByte = 0 then
+ Exit([ptNonDeterministic]);
+
+ Result := [];
+ for LPayloadType := Low(TPayloadTrait) to High(TPayloadTrait) do begin
+ LPayloadTypeByte := LPayloadType.ToProtocolValue;
+ if (AByte AND LPayloadTypeByte) = LPayloadTypeByte then
+ Result := Result + [LPayloadType];
+ end;
+end;
+
+class function TEPasaComp.FromProtocolValue(AVal : Byte) : TPayloadType;
+begin
+ if AVal = 0 then begin
+ Exit([ptNonDeterministic]);
+ end;
+ Result := [];
+ if AVal AND BYTE_BIT_0 <> 0 then Result := Result + [ptPublic];
+ if AVal AND BYTE_BIT_1 <> 0 then Result := Result + [ptRecipientKeyEncrypted];
+ if AVal AND BYTE_BIT_2 <> 0 then Result := Result + [ptSenderKeyEncrypted];
+ if AVal AND BYTE_BIT_3 <> 0 then Result := Result + [ptPasswordEncrypted];
+ if AVal AND BYTE_BIT_4 <> 0 then Result := Result + [ptAsciiFormatted];
+ if AVal AND BYTE_BIT_5 <> 0 then Result := Result + [ptHexFormatted];
+ if AVal AND BYTE_BIT_6 <> 0 then Result := Result + [ptBase58Formatted];
+ if AVal AND BYTE_BIT_7 <> 0 then Result := Result + [ptAddressedByName];
+end;
+
+
+
+
+initialization
+{$IFDEF FPC}
+FillChar(EmptyEPasa, SizeOf(EmptyEPASA), 0);
+{$ELSE}
+EmptyEPasa := Default(TEPasa);
+{$ENDIF}
+end.
diff --git a/src/core/UEPasaDecoder.pas b/src/core/UEPasaDecoder.pas
new file mode 100644
index 000000000..3c8bd8341
--- /dev/null
+++ b/src/core/UEPasaDecoder.pas
@@ -0,0 +1,300 @@
+unit UEPasaDecoder;
+
+{ Copyright (c) PascalCoin Developers - Herman Schoenfeld - Albert Molina
+
+ PIP-0027: E-PASA Reference Implementation
+ See: https://github.com/PascalCoin/PascalCoin/blob/master/PIP/PIP-0027.md
+
+ Distributed under the MIT software license, see the accompanying file LICENSE
+ or visit http://www.opensource.org/licenses/mit-license.php.
+
+ This unit is a part of the PascalCoin Project, an infinitely scalable
+ cryptocurrency. Find us here:
+ Source: https://github.com/PascalCoin/PascalCoin
+
+ THIS LICENSE HEADER MUST NOT BE REMOVED.
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+ {$ZEROBASEDSTRINGS OFF}
+{$ENDIF FPC}
+
+interface
+
+{$I ./../config.inc}
+
+uses
+ SysUtils,
+ TypInfo,
+ {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF},
+ UBlockChain, UNode, UBaseTypes, UPCDataTypes,
+ UAccounts,
+ UEncoding,
+ UEPasa,
+ UWallet,
+ URPC, UJSONFunctions;
+
+type
+ TDecodeEPasaResult = (der_Decoded, der_Undefined, der_NonDeterministic, der_InvalidPayloadType, der_AccountNameNotFound, der_NotEnoughData, der_PrivateKeyNotFound, der_PasswordNotFound);
+
+ TEPasaDecoder = Class
+ public
+ class Function TryDecodeEPASA(AAccount : Cardinal; const APayload : TOperationPayload; const ANode : TNode; const AWalletKeys : TWalletKeys; const APasswords : TList;
+ out ADecodeEPasaResult : TDecodeEPasaResult; out AEPasa : TEPasa) : Boolean; overload;
+ class Function TryDecodeEPASA(AAccount : Cardinal; const APayload : TOperationPayload; const ANode : TNode; const AWalletKeys : TWalletKeys; const APasswords : TList;
+ out AEPasa : TEPasa) : Boolean; overload;
+ class Function DecodeEPASA(AAccount : Cardinal; const APayload : TOperationPayload; const ANode : TNode; const AWalletKeys : TWalletKeys; const APasswords : TList) : String; overload;
+ class function CheckEPasa(const ASender : TRPCProcess; const AAccount_EPasa : String; AJSONResponse : TPCJSONObject; var AErrorNum : Integer; var AErrorDesc : String) : Boolean; overload;
+ class function CheckEPasa(const ASender : TRPCProcess; const AMethodName : String; AInputParams, AJSONResponse : TPCJSONObject; var AErrorNum : Integer; var AErrorDesc : String) : Boolean; overload;
+ class function ValidateEPasa(const ASender : TRPCProcess; const AMethodName : String; AInputParams, AJSONResponse : TPCJSONObject; var AErrorNum : Integer; var AErrorDesc : String) : Boolean;
+ End;
+
+implementation
+
+uses UPCEncryption, UCommon, UCrypto;
+
+{ TEPasaDecoder }
+
+class function TEPasaDecoder.TryDecodeEPASA(AAccount: Cardinal;
+ const APayload: TOperationPayload; const ANode : TNode; const AWalletKeys: TWalletKeys;
+ const APasswords: TList; out ADecodeEPasaResult: TDecodeEPasaResult;
+ out AEPasa: TEPasa): Boolean;
+var
+ LUnencryptedPayloadBytes, LPwd : TBytes;
+ LDone : Boolean;
+ i : Integer;
+ LAccount : TAccount;
+begin
+ LUnencryptedPayloadBytes := Nil;
+ AEPasa.Clear;
+ Result := False;
+ ADecodeEPasaResult := der_Decoded;
+ AEPasa.Account := AAccount;
+ AEPasa.AccountChecksum := TEPasa.CalculateAccountChecksum(AAccount);
+ AEPasa.PayloadType := TEPasaComp.FromProtocolValue(APayload.payload_type);
+ if AEPasa.PayloadType.HasTrait(ptNonDeterministic) then begin
+ ADecodeEPasaResult := der_NonDeterministic;
+ Exit(False);
+ end;
+ if Not AEPasa.PayloadType.IsValid then begin
+ ADecodeEPasaResult := der_InvalidPayloadType;
+ Exit(False);
+ end;
+
+ if AEPasa.PayloadType.HasTrait(ptAddressedByName) then begin
+ if (AEPasa.PayloadType.HasTrait(ptPublic) and
+ AEPasa.PayloadType.HasTrait(ptBase58Formatted)) then begin
+ // PayToKey candidate...
+ AEPasa.AccountName := '@';
+ end else begin
+ if Assigned(ANode) then begin
+ LAccount := ANode.GetMempoolAccount(AAccount);
+ AEPasa.AccountName := LAccount.name.ToPrintable;
+ end;
+ if AEPasa.AccountName='' then begin
+ ADecodeEPasaResult := der_AccountNameNotFound; // Will continue processing
+ end;
+ end;
+ end;
+
+ // payload data
+ if (Length(APayload.payload_raw)=0) then begin
+ // Nothing to decode...
+ end else if (AEPasa.PayloadType.HasTrait(ptSenderKeyEncrypted)) or (AEPasa.PayloadType.HasTrait(ptRecipientKeyEncrypted)) then begin
+ if Assigned(AWalletKeys) then begin
+ LDone := False;
+ i := 0;
+ while (Not LDone) and (i < AWalletKeys.Count) do begin
+ if Assigned(AWalletKeys.Key[i].PrivateKey) then begin
+ if TPCEncryption.DoPascalCoinECIESDecrypt(AWalletKeys.Key[i].PrivateKey.PrivateKey,APayload.payload_raw,LUnencryptedPayloadBytes) then begin
+ LDone := True;
+ end;
+ end;
+ inc(i);
+ end;
+ if Not LDone then begin
+ ADecodeEPasaResult := der_PrivateKeyNotFound;
+ Exit(False);
+ end;
+ end else begin
+ ADecodeEPasaResult := der_NotEnoughData;
+ Exit(False);
+ end;
+ end else if (AEPasa.PayloadType.HasTrait(ptPasswordEncrypted)) then begin
+ if Assigned(APasswords) then begin
+ LDone := False;
+ i := 0;
+ while (Not LDone) and (i < APasswords.Count) do begin
+ LPwd.FromString(APasswords[i]);
+ if TPCEncryption.DoPascalCoinAESDecrypt(APayload.payload_raw,LPwd,LUnencryptedPayloadBytes) then begin
+ AEPasa.Password := APasswords[i];
+ LDone := True;
+ end;
+ inc(i);
+ end;
+ if Not LDone then begin
+ ADecodeEPasaResult := der_PasswordNotFound;
+ Exit(False);
+ end;
+ end else begin
+ ADecodeEPasaResult := der_NotEnoughData;
+ Exit(False);
+ end;
+ end else begin
+ if (Not AEPasa.PayloadType.HasTrait(ptPublic)) then begin
+ // Internal Error
+ ADecodeEPasaResult := der_Undefined;
+ Exit(False);
+ end;
+ LUnencryptedPayloadBytes := APayload.payload_raw;
+ end;
+ // LUnencryptedPayloadBytes Has Value in RAW
+ if (AEPasa.PayloadType.HasTrait(ptAsciiFormatted)) then begin
+ AEPasa.Payload := LUnencryptedPayloadBytes.ToString;
+ end else if (AEPasa.PayloadType.HasTrait(ptHexFormatted)) then begin
+ AEPasa.Payload := THexEncoding.Encode(LUnencryptedPayloadBytes,True);
+ end else if (AEPasa.PayloadType.HasTrait(ptBase58Formatted)) then begin
+ AEPasa.Payload := TPascalBase58Encoding.Encode(LUnencryptedPayloadBytes);
+ end else begin
+ // Internal error
+ ADecodeEPasaResult := der_Undefined;
+ Exit(False);
+ end;
+ Result := true;
+end;
+
+class function TEPasaDecoder.CheckEPasa(const ASender: TRPCProcess;
+ const AMethodName: String; AInputParams, AJSONResponse: TPCJSONObject;
+ var AErrorNum: Integer; var AErrorDesc: String): Boolean;
+begin
+ Result := CheckEPAsa(ASender,AInputParams.AsString('account_epasa',''),AJSONResponse,AErrorNum,AErrorDesc);
+end;
+
+class function TEPasaDecoder.CheckEPasa(const ASender: TRPCProcess;
+ const AAccount_EPasa: String; AJSONResponse: TPCJSONObject;
+ var AErrorNum: Integer; var AErrorDesc: String): Boolean;
+var LEPasa : TEPasa;
+ LResultObject : TPCJSONObject;
+begin
+ if Not TEPasa.TryParse(AAccount_EPasa,LEPasa) then begin
+ AErrorNum := CT_RPC_ErrNum_InvalidEPASA;
+ AErrorDesc := 'Not a valid epasa: '+AAccount_EPasa;
+ Result := False;
+ Exit(False);
+ end else begin
+ Result := True;
+ LResultObject := AJSONResponse.GetAsObject('result');
+ LResultObject.GetAsVariant('account_epasa').Value := LEPasa.ToString(False);
+ LResultObject.GetAsVariant('account_epasa_classic').Value := LEPasa.ToClassicPASAString;
+
+ if LEPasa.PayloadType.HasTrait(ptAddressedByName) then begin
+ LResultObject.GetAsVariant('account').Value := LEPasa.AccountName;
+ end else begin
+ LResultObject.GetAsVariant('account').Value := LEPasa.Account.Value;
+ end;
+
+ if LEPasa.PayloadType.HasTrait(ptPublic) then begin
+ LResultObject.GetAsVariant('payload_method').Value := 'none';
+ end else if LEPasa.PayloadType.HasTrait(ptSenderKeyEncrypted) then begin
+ LResultObject.GetAsVariant('payload_method').Value := 'sender';
+ end else if LEPasa.PayloadType.HasTrait(ptRecipientKeyEncrypted) then begin
+ LResultObject.GetAsVariant('payload_method').Value := 'dest';
+ end else if LEPasa.PayloadType.HasTrait(ptPasswordEncrypted) then begin
+ LResultObject.GetAsVariant('payload_method').Value := 'aes';
+ LResultObject.GetAsVariant('pwd').Value := LEPasa.Password;
+ end;
+
+ if LEPasa.PayloadType.HasTrait(ptAsciiFormatted) then begin
+ LResultObject.GetAsVariant('payload_encode').Value := 'string';
+ end else if LEPasa.PayloadType.HasTrait(ptHexFormatted) then begin
+ LResultObject.GetAsVariant('payload_encode').Value := 'hexa';
+ end else if LEPasa.PayloadType.HasTrait(ptBase58Formatted) then begin
+ LResultObject.GetAsVariant('payload_encode').Value := 'base58';
+ end;
+
+ LResultObject.GetAsVariant('payload').Value := LEPasa.GetRawPayloadBytes.ToHexaString;
+ LResultObject.GetAsVariant('payload_type').Value := LEPasa.PayloadType.ToProtocolValue;
+ LResultObject.GetAsVariant('is_pay_to_key').Value := LEPasa.IsPayToKey;
+ end;
+end;
+
+class function TEPasaDecoder.DecodeEPASA(AAccount: Cardinal;
+ const APayload: TOperationPayload; const ANode: TNode;
+ const AWalletKeys: TWalletKeys; const APasswords: TList): String;
+var LEPasa : TEPasa;
+begin
+ if TryDecodeEPASA(AAccount,APayload,ANode,AWalletKeys,APasswords,LEPasa) then begin
+ Result := LEPasa.ToClassicPASAString;
+ end else Result := '';
+end;
+
+class function TEPasaDecoder.TryDecodeEPASA(AAccount: Cardinal;
+ const APayload: TOperationPayload; const ANode : TNode; const AWalletKeys: TWalletKeys;
+ const APasswords: TList; out AEPasa: TEPasa): Boolean;
+var LDecodeEPasaResult: TDecodeEPasaResult;
+begin
+ Result := TryDecodeEPASA(AAccount,APayload,ANode,AWalletKeys,APasswords,LDecodeEPasaResult,AEPasa);
+end;
+
+class function TEPasaDecoder.ValidateEPasa(const ASender: TRPCProcess;
+ const AMethodName: String; AInputParams, AJSONResponse: TPCJSONObject;
+ var AErrorNum: Integer; var AErrorDesc: String): Boolean;
+var
+ s : String;
+ card : Cardinal;
+ LEPasaStr, LDelimStart,LDelimEnd, LPwdZone, LPayload : String;
+ LRawPayload : TRawBytes;
+begin
+ LEPasaStr := '';
+ LPwdZone := '';
+ LEPasaStr := AInputParams.AsString('account','');
+ s := Trim(AInputParams.AsString('payload_method','none'));
+ if s='dest' then begin
+ LDelimStart := '(';
+ LDelimEnd := ')';
+ end else if s='sender' then begin
+ LDelimStart := '<';
+ LDelimEnd := '>';
+ end else if s='aes' then begin
+ LDelimStart := '{';
+ LDelimEnd := '}';
+ LPwdZone := ':' + AInputParams.AsString('pwd','');
+ end else if (s='none') or (trim(s)='') then begin
+ LDelimStart := '[';
+ LDelimEnd := ']';
+ end else begin
+ AErrorNum := CT_RPC_ErrNum_InvalidData;
+ AErrorDesc := Format('"payload_method" %s not valid',[s]);
+ Exit(False);
+ end;
+ s := Trim(AInputParams.AsString('payload',''));
+ if Not TCrypto.HexaToRaw(s,LRawPayload) then begin
+ AErrorNum := CT_RPC_ErrNum_InvalidData;
+ AErrorDesc := Format('"payload" is not an HEXASTRING: %s',[s]);
+ Exit(False);
+ end;
+ s := Trim(AInputParams.AsString('payload_encode','string'));
+ if s='hexa' then begin
+ LPayload := '0x'+LRawPayload.ToHexaString;
+ end else if s='base58' then begin
+ LPayload := TPascalBase58Encoding.Encode(LRawPayload);
+ end else if (s='string') or (Trim(s)='') then begin
+ LPayload := '"'+TPascalAsciiEncoding.Escape(LRawPayload.ToString)+'"';
+ end else begin
+ AErrorNum := CT_RPC_ErrNum_InvalidData;
+ AErrorDesc := Format('"payload_encode" %s not valid',[s]);
+ Exit(False);
+ end;
+
+ LEPasaStr := AInputParams.AsString('account','') + LDelimStart + LPayload + LPwdZone + LDelimEnd;
+ Result := CheckEPasa(ASender,LEPasaStr,AJSONResponse,AErrorNum,AErrorDesc);
+end;
+
+initialization
+ TRPCProcess.RegisterProcessMethod('validateepasa',TEPasaDecoder.ValidateEPasa);
+ TRPCProcess.RegisterProcessMethod('checkepasa',TEPasaDecoder.CheckEPasa);
+finalization
+ TRPCProcess.UnregisterProcessMethod('validateepasa');
+ TRPCProcess.UnregisterProcessMethod('checkepasa');
+end.
diff --git a/src/core/UEncoding.pas b/src/core/UEncoding.pas
new file mode 100644
index 000000000..e4bf715a5
--- /dev/null
+++ b/src/core/UEncoding.pas
@@ -0,0 +1,568 @@
+unit UEncoding;
+
+{ Copyright (c) 2020 by Herman Schoenfeld
+
+ Contains text encoding schemes used through PascalCoin.
+
+ Distributed under the MIT software license, see the accompanying file LICENSE
+ or visit http://www.opensource.org/licenses/mit-license.php.
+
+ This unit is a part of the PascalCoin Project, an infinitely scalable
+ cryptocurrency. Find us here:
+ Web: https://www.pascalcoin.org
+ Source: https://github.com/PascalCoin/PascalCoin
+
+ THIS LICENSE HEADER MUST NOT BE REMOVED.
+}
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+interface
+
+uses
+ SysUtils,
+ TypInfo,
+ uregexpr,
+ UCommon,
+ UCrypto;
+
+
+type
+
+ { TCustomRegex }
+
+ TCustomRegex = class sealed(TObject)
+ var
+ FRegex: TRegExpr;
+ public
+ constructor Create(const ARegexExpression: String);
+ destructor Destroy(); override;
+ function IsMatch(const AInputString: String): Boolean;
+ function GetMatchFromName(const AGroupName: String): String;
+ function Value(): String;
+ procedure Match(const AInputString: String);
+ end;
+
+
+ { TPascalAsciiEncoding }
+
+ TPascalAsciiEncoding = class sealed(TObject)
+ strict private
+ class var FEscapedStringRegex: TCustomRegex;
+ class constructor CreatePascalAsciiEncoding();
+ class destructor DestroyPascalAsciiEncoding();
+
+ public
+ const
+ EscapeChar: Char = '\';
+ CharSet = ' !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~';
+ CharSetEscaped = '"():<>[\]{}';
+ CharSetUnescaped = ' !#$%&''*+,-./0123456789;=?@ABCDEFGHIJKLMNOPQRSTUVWXYZ^_`abcdefghijklmnopqrstuvwxyz|~';
+ CharPattern = '( |!|\\"|#|\$|%|&|''|\\\(|\\\)|\*|\+|,|-|\.|/|0|1|2|3|4|5|6|7|8|9|\\:|;|\\<|=|\\>|\?|@|A|B|C|D|E|F|G|H|I|J|K|L|M|N|O|P|Q|R|S|T|U|V|W|X|Y|Z|\\\[|\\\\|\\]|\^|_|`|a|b|c|d|e|f|g|h|i|j|k|l|m|n|o|p|q|r|s|t|u|v|w|x|y|z|\\\{|\||\\\}|~)';
+ StringPattern = CharPattern + '+';
+
+ class function IsValidEscaped(const ASafeAnsiString: String) : Boolean; static;
+ class function IsValidUnescaped(const AUnescapedPascalAsciiString: String) : Boolean; static;
+ class function Escape(const APascalAsciiString: String): String; static;
+ class function Unescape(const APascalAsciiString: String): String; static;
+ end;
+
+ { TPascal64Encoding }
+
+ TPascal64Encoding = class sealed(TObject)
+ strict private
+ class var FEscapedRegex: TCustomRegex;
+ class constructor CreatePascal64Encoding();
+ class destructor DestroyPascal64Encoding();
+ public
+ const
+ EscapeChar: Char = '\';
+ CharSet = 'abcdefghijklmnopqrstuvwxyz0123456789!@#$%^&*()-+{}[]_:"`|<>,.?/~';
+ CharSetStart = 'abcdefghijklmnopqrstuvwxyz!@#$%^&*()-+{}[]_:"`|<>,.?/~';
+ CharSetEscaped = '(){}[]:"<>';
+ CharSetUnescaped = 'abcdefghijklmnopqrstuvwxyz0123456789!@#$%^&*-+_`|,.?/~';
+ StartCharPattern = '(a|b|c|d|e|f|g|h|i|j|k|l|m|n|o|p|q|r|s|t|u|v|w|x|y|z|!|@|#|\$|%|\^|&|\*|\\\(|\\\)|-|\+|\\\{|\\\}|\\\[|\\]|_|\\:|\\"|`|\||\\<|\\>|,|\.|\?|/|~)';
+ NextCharPattern = '(a|b|c|d|e|f|g|h|i|j|k|l|m|n|o|p|q|r|s|t|u|v|w|x|y|z|0|1|2|3|4|5|6|7|8|9|!|@|#|\$|%|\^|&|\*|\\\(|\\\)|-|\+|\\\{|\\\}|\\\[|\\]|_|\\:|\\"|`|\||\\<|\\>|,|\.|\?|/|~)';
+ StringPattern = StartCharPattern + NextCharPattern + '*';
+ StringOnlyPattern = StringPattern + '$';
+
+ class function IsValidEscaped(const AEscapedPascal64String: String) : Boolean; static;
+ class function IsValidUnescaped(const AUnescapedPascal64String: String) : Boolean; static;
+ class function Escape(const APascal64String: String): String; static;
+ class function Unescape(const APascal64String: String): String; static;
+ end;
+
+
+ { THexEncoding }
+
+ THexEncoding = class sealed(TObject)
+ private
+ class var FHexStringRegex: TCustomRegex;
+ class constructor CreateHexEncoding();
+ class destructor DestroyHexEncoding();
+
+ public
+ const
+ CharSet = '0123456789abcdef';
+ NibblePattern = '[0-9a-fA-F]';
+ BytePattern = NibblePattern + '{2}';
+ SubStringPattern = '(?:' + BytePattern + ')+';
+ StringPattern = SubStringPattern + '$';
+
+ class function IsValid(const AHexString: String): Boolean; static;
+ class function Decode(const AHexString: String): TArray; static;
+ class function TryDecode(const AHexString: String; out AResult: TArray): Boolean; static;
+ class function Encode(const ABytes: TArray; AOmitPrefix: Boolean = True): String; static;
+ end;
+
+ { TPascalBase58Encoding }
+
+ TPascalBase58Encoding = class sealed(TObject)
+ private
+ class var FStringRegex: TCustomRegex;
+ class constructor CreatePascalBase58Encoding();
+ class destructor DestroyPascalBase58Encoding();
+
+ public
+ const
+ CharSet = '123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz';
+ CharPattern = '[123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz]';
+ SubStringPattern = CharPattern + '+';
+ StringPattern = SubStringPattern + '$';
+
+ class function IsValid(const ABase58String: String): Boolean; static;
+ class function Decode(const ABase58String: String): TArray; static;
+ class function TryDecode(const ABase58String: String; out AResult: TArray): Boolean; static;
+ class function Encode(const ABytes: TArray): String; static;
+ end;
+
+ { TPASCEncoding }
+
+ TPASCEncoding = class sealed(TObject)
+ public
+ class function IsValid(const APasc: String): Boolean; static;
+ class function Decode(const APasc: String): Int64; static;
+ class function TryDecode(const APasc: String; out AMolinas: Int64) : Boolean; static;
+ class function Encode(const AMolinas: Int64): String; static;
+ end;
+
+
+ { TStringExtensions }
+
+ TStringExtensions = class sealed(TObject)
+ public
+ class function Escape(const AStr: String; AEscapeSymbol: Char; const AEscapedChars: TArray): String; static;
+ class function Unescape(const AStr: String; AEscapeSymbol: Char; const AEscapedChars: TArray): String; static;
+ class function All(const ANeedle: String; const AStack: String) : Boolean; static;
+ end;
+
+resourcestring
+ SUnknownPayloadEncoding = 'Unknown payload encoding.';
+ SInvalidEPasaFormat = 'Invalid E-PASA format, %s';
+ SInvalidEPasa = 'Invalid EPASA "%s": %s';
+ SInvalidHexString = 'Invalid hex-formatted string, %s';
+ SInvalidBase58String = 'Invalid Base58-formatted string, %s';
+ SBase58EncodeError = 'Error Encoding to Base58';
+ SUnRecognizedStartCharacter = 'Unrecognized start character, %s';
+ SInvalidPASCQuantity = 'Invalid PASC quantity string, %s';
+
+implementation
+
+uses
+ HlpHashFactory,
+ HlpIHashInfo,
+ HlpConverters,
+ UJSONFunctions;
+
+{ TCustomRegex }
+
+constructor TCustomRegex.Create(const ARegexExpression: String);
+begin
+ inherited Create();
+ FRegex := TRegExpr.Create(ARegexExpression);
+end;
+
+destructor TCustomRegex.Destroy;
+begin
+ FRegex.Free;
+ inherited Destroy;
+end;
+
+function TCustomRegex.GetMatchFromName(const AGroupName: String): String;
+var
+ i: Int32;
+begin
+ Result := #0;
+ // carefull: E:\SourceCode\PascalCoin-master\src\libraries\regex must be added to project file
+ // otherwise wrong unit will be used from:
+ // Drive:\Tools\Lazarus\fpc\3.2.0\source\packages\regexpr\src
+ i := FRegex.MatchIndexFromName(AGroupName);
+ if i >= 0 then begin
+ Result := FRegex.Match[i];
+ end;
+end;
+
+function TCustomRegex.IsMatch(const AInputString: String): Boolean;
+begin
+ Result := FRegex.Exec(AInputString);
+end;
+
+procedure TCustomRegex.Match(const AInputString: String);
+begin
+ FRegex.Exec(AInputString);
+end;
+
+function TCustomRegex.Value: String;
+begin
+ Result := FRegex.Match[0];
+end;
+
+{ TPascalAsciiEncoding }
+
+class function TPascalAsciiEncoding.IsValidEscaped(const ASafeAnsiString : String): Boolean;
+begin
+ Result := FEscapedStringRegex.IsMatch(ASafeAnsiString);
+end;
+
+class function TPascalAsciiEncoding.IsValidUnescaped (const AUnescapedPascalAsciiString: String): Boolean;
+begin
+ Result := TStringExtensions.All(AUnescapedPascalAsciiString, CharSet);
+end;
+
+class function TPascalAsciiEncoding.Escape(const APascalAsciiString : String): String;
+begin
+ Result := TStringExtensions.Escape(APascalAsciiString, EscapeChar, CharSetEscaped.ToCharArray);
+end;
+
+class function TPascalAsciiEncoding.Unescape(const APascalAsciiString : String): String;
+begin
+ Result := TStringExtensions.Unescape(APascalAsciiString, EscapeChar, CharSetEscaped.ToCharArray);
+end;
+
+class constructor TPascalAsciiEncoding.CreatePascalAsciiEncoding;
+begin
+ FEscapedStringRegex := TCustomRegex.Create(StringPattern);
+end;
+
+class destructor TPascalAsciiEncoding.DestroyPascalAsciiEncoding;
+begin
+ FEscapedStringRegex.Free;
+end;
+
+{ TPascal64Encoding }
+
+class function TPascal64Encoding.IsValidEscaped(const AEscapedPascal64String : String): Boolean;
+begin
+ Result := FEscapedRegex.IsMatch(AEscapedPascal64String);
+end;
+
+class function TPascal64Encoding.IsValidUnescaped(const AUnescapedPascal64String : String): Boolean;
+begin
+ Result := (3 <= AUnescapedPascal64String.Length) and
+ (AUnescapedPascal64String.Length <= 64) and
+ (StartCharPattern.Contains(AUnescapedPascal64String[1])) and
+ (TStringExtensions.All(AUnescapedPascal64String, CharSet));
+end;
+
+class function TPascal64Encoding.Escape(const APascal64String: String): String;
+begin
+ Result := TStringExtensions.Escape(APascal64String, EscapeChar,
+ CharSetEscaped.ToCharArray);
+end;
+
+class function TPascal64Encoding.Unescape(const APascal64String : String): String;
+begin
+ Result := TStringExtensions.Unescape(APascal64String, EscapeChar,
+ CharSetEscaped.ToCharArray);
+end;
+
+class constructor TPascal64Encoding.CreatePascal64Encoding;
+begin
+ FEscapedRegex := TCustomRegex.Create(StringOnlyPattern);
+end;
+
+class destructor TPascal64Encoding.DestroyPascal64Encoding;
+begin
+ FEscapedRegex.Free;
+end;
+
+{ THexEncoding }
+
+class function THexEncoding.IsValid(const AHexString: String): Boolean;
+begin
+ Result := FHexStringRegex.IsMatch(AHexString);
+end;
+
+class function THexEncoding.Decode(const AHexString: String): TArray;
+begin
+ if (not TryDecode(AHexString, Result)) then
+ raise EArgumentException.CreateResFmt(@SInvalidHexString, ['AHexString']);
+end;
+
+class function THexEncoding.TryDecode(const AHexString: String; out AResult: TArray): Boolean;
+begin
+ AResult := Nil;
+ if (not IsValid(AHexString)) then
+ Exit(False);
+
+ Result := TryHex2Bytes(AHexString, AResult);
+end;
+
+class function THexEncoding.Encode(const ABytes: TArray; AOmitPrefix: Boolean): String;
+begin
+ Result := Bytes2Hex(ABytes, not AOmitPrefix).ToLowerInvariant;
+end;
+
+class constructor THexEncoding.CreateHexEncoding;
+begin
+ FHexStringRegex := TCustomRegex.Create(StringPattern);
+end;
+
+class destructor THexEncoding.DestroyHexEncoding;
+begin
+ FHexStringRegex.Free;
+end;
+
+{ TPascalBase58Encoding }
+
+class function TPascalBase58Encoding.IsValid(const ABase58String : String): Boolean;
+begin
+ Result := FStringRegex.IsMatch(ABase58String);
+end;
+
+class function TPascalBase58Encoding.Decode(const ABase58String: String) : TArray;
+begin
+ if (not TryDecode(ABase58String, Result)) then
+ raise EArgumentException.CreateResFmt(@SInvalidBase58String, ['ABase58String']);
+end;
+
+class function TPascalBase58Encoding.TryDecode(const ABase58String: String; out AResult: TArray): Boolean;
+var
+ LBN, LBNAux, LBNBase: TBigNum;
+ i, LOffset: Int32;
+begin
+ Result := False;
+ LBN := TBigNum.Create(0);
+ LBNAux := TBigNum.Create;
+ LBNBase := TBigNum.Create(1);
+
+ try
+ for i := ABase58String.Length downto 1 do begin
+ LOffset := System.Pos(ABase58String[i], CharSet) - 1;
+ if LOffset < 0 then begin
+ Exit(False);
+ end;
+ LBNAux.Value := LOffset;
+ LBNAux.Multiply(LBNBase);
+ LBN.Add(LBNAux);
+ LBNBase.Multiply(CharSet.Length);
+ end;
+ AResult := THexEncoding.Decode(LBN.HexaValue);
+ finally
+ LBN.Free;
+ LBNAux.Free;
+ LBNBase.Free;
+ end;
+ TArrayTool.RemoveAt(AResult, 0);
+ Result := True;
+end;
+
+class function TPascalBase58Encoding.Encode(const ABytes: TArray): String;
+Var
+ LBN, LBNMod, LBNDiv: TBigNum;
+begin
+ Result := string.Empty;
+ LBN := TBigNum.Create;
+ LBNMod := TBigNum.Create;
+ LBNDiv := TBigNum.Create(CharSet.Length);
+
+ try
+ LBN.HexaValue := '01' + THexEncoding.Encode(ABytes);
+ while (not LBN.IsZero) do begin
+ LBN.Divide(LBNDiv, LBNMod);
+ If (LBNMod.Value >= 0) and (LBNMod.Value < CharSet.Length) then begin
+ Result := CharSet[Byte(LBNMod.Value) + 1] + Result;
+ end else begin
+ raise Exception.CreateRes(@SBase58EncodeError);
+ end;
+ end;
+ finally
+ LBN.Free;
+ LBNMod.Free;
+ LBNDiv.Free;
+ end;
+end;
+
+class constructor TPascalBase58Encoding.CreatePascalBase58Encoding;
+begin
+ FStringRegex := TCustomRegex.Create(StringPattern);
+end;
+
+class destructor TPascalBase58Encoding.DestroyPascalBase58Encoding;
+begin
+ FStringRegex.Free;
+end;
+
+{ TPASCEncoding }
+
+class function TPASCEncoding.IsValid(const APasc: String): Boolean;
+var
+ temp: Int64;
+begin
+ Result := TryDecode(APasc, temp);
+end;
+
+class function TPASCEncoding.Decode(const APasc: String): Int64;
+begin
+ if (not TryDecode(APasc, Result)) then
+ begin
+ raise EArgumentException.CreateResFmt(@SInvalidPASCQuantity, ['APasc']);
+ end;
+end;
+
+class function TPASCEncoding.TryDecode(const APasc: String; out AMolinas: Int64): Boolean; var s : String;
+ LPosThousand, LPosDecimal : Integer;
+ LMoneyString : String;
+begin
+ AMolinas := 0;
+ LMoneyString := Trim(APasc);
+ if LMoneyString.Length=0 then begin
+ Result := true;
+ exit;
+ end;
+ try
+ LPosThousand := LMoneyString.IndexOf( TPCJSONData.JSONFormatSettings.ThousandSeparator );
+ LPosDecimal := LMoneyString.IndexOf( TPCJSONData.JSONFormatSettings.DecimalSeparator );
+
+ if (LPosThousand>0) then begin
+ if (LPosThousand < LPosDecimal ) then begin
+ // Remove thousand values
+ LMoneyString := LMoneyString.Replace(String(TPCJSONData.JSONFormatSettings.ThousandSeparator),'',[rfReplaceAll]);
+ end else begin
+ // Possible 15.123.456,7890 format ( coma (,) = decimal separator )
+ // Remove decimal "." and convert thousand to decimal
+ LMoneyString := LMoneyString.Replace(String(TPCJSONData.JSONFormatSettings.DecimalSeparator),'',[rfReplaceAll]);
+ LMoneyString := LMoneyString.Replace(TPCJSONData.JSONFormatSettings.ThousandSeparator,TPCJSONData.JSONFormatSettings.DecimalSeparator,[rfReplaceAll]);
+ end;
+ end;
+
+ AMolinas := Round( StrToFloat(LMoneyString,TPCJSONData.JSONFormatSettings)*10000 );
+ Result := true;
+ Except
+ result := false;
+ end;
+
+end;
+
+class function TPASCEncoding.Encode(const AMolinas: Int64): String;
+begin
+ Result := FormatFloat('#,###0.0000',(AMolinas/10000.0), TPCJSONData.JSONFormatSettings);
+end;
+
+{ TStringExtensions }
+
+class function TStringExtensions.Escape(const AStr: String; AEscapeSymbol: Char; const AEscapedChars: TArray): String;
+var
+ LPPtr: PChar;
+ LPeek, LNext: Char;
+begin
+ Result := String.Empty;
+ LPPtr := PChar(AStr);
+
+ while LPPtr^ <> #0 do
+ begin
+ LPeek := LPPtr^;
+ if LPeek = AEscapeSymbol then
+ begin
+ Result := Result + LPPtr^; // append escape symbol
+ System.Inc(LPPtr);
+ LNext := LPPtr^;
+ if LNext = #0 then
+ begin
+ // end of string, last char was escape symbol
+ if (TArrayTool.Contains(AEscapedChars, AEscapeSymbol)) then
+ begin
+ // need to escape it
+ Result := Result + AEscapeSymbol;
+ end;
+ end
+ else if (TArrayTool.Contains(AEscapedChars, LNext)) then
+ begin
+ // is an escape sequence, append next char
+ Result := Result + LPPtr^;
+ System.Inc(LPPtr);
+ end
+ else
+ begin
+ // is an invalid escape sequence
+ if (TArrayTool.Contains(AEscapedChars, AEscapeSymbol)) then
+ begin
+ // need to escape symbol, since it's an escaped char
+ Result := Result + AEscapeSymbol;
+ end;
+ end;
+
+ end
+ else if (TArrayTool.Contains(AEscapedChars, LPeek)) then
+ begin
+ // char needs escaping
+ Result := Result + AEscapeSymbol + LPPtr^;
+ System.Inc(LPPtr);
+ end
+ else
+ begin
+ // normal char
+ Result := Result + LPPtr^;
+ System.Inc(LPPtr);
+ end;
+ end;
+end;
+
+class function TStringExtensions.Unescape(const AStr: String; AEscapeSymbol: Char; const AEscapedChars: TArray): String;
+var
+ LPPtr: PChar;
+ LPeek: Char;
+begin
+ Result := String.Empty;
+ LPPtr := PChar(AStr);
+
+ while LPPtr^ <> #0 do
+ begin
+ LPeek := LPPtr^;
+ if LPeek = AEscapeSymbol then begin
+ System.Inc(LPPtr); // omit the escape symbol
+ LPeek := LPPtr^;
+ if LPeek = #0 then begin
+ // last character was the escape symbol, so include it
+ Result := Result + AEscapeSymbol;
+ break;
+ end;
+
+ if (not(TArrayTool.Contains(AEscapedChars, LPeek))) then begin
+ // was not an escaped char, so include the escape symbol
+ Result := Result + AEscapeSymbol;
+ continue;
+ end;
+
+ end;
+ // include the char (or escaped char)
+ Result := Result + LPPtr^;
+ System.Inc(LPPtr);
+ end;
+end;
+
+class function TStringExtensions.All(const ANeedle: String; const AStack: String): Boolean;
+var
+ c: Char;
+begin
+ Result := True;
+ for c in ANeedle do
+ begin
+ if not AStack.Contains(c) then
+ Exit(False);
+ end;
+end;
+
+end.
diff --git a/src/core/UFileStorage.pas b/src/core/UFileStorage.pas
index 311a3a35e..672eb3c31 100644
--- a/src/core/UFileStorage.pas
+++ b/src/core/UFileStorage.pas
@@ -29,7 +29,7 @@ interface
Type
- TBlockHeader = Record
+ TBlockHeader = packed record
BlockNumber : Cardinal;
StreamBlockRelStartPos : Int64;
BlockSize : Cardinal;
@@ -41,55 +41,36 @@ interface
TFileStorage = Class(TStorage)
private
- FLowMemoryUsage: Boolean;
FStorageLock : TPCCriticalSection;
FBlockChainStream : TFileStream;
- FPendingBufferOperationsStream : TFileStream;
FStreamFirstBlockNumber : Int64;
FStreamLastBlockNumber : Int64;
FBlockHeadersFirstBytePosition : TArrayOfInt64;
- FDatabaseFolder: AnsiString;
- FBlockChainFileName : AnsiString;
Function StreamReadBlockHeader(Stream: TStream; iBlockHeaders : Integer; BlockHeaderFirstBlock, Block: Cardinal; CanSearchBackward : Boolean; var BlockHeader : TBlockHeader): Boolean;
Function StreamBlockRead(Stream : TStream; iBlockHeaders : Integer; BlockHeaderFirstBlock, Block : Cardinal; Operations : TPCOperationsComp) : Boolean;
Function StreamBlockSave(Stream : TStream; iBlockHeaders : Integer; BlockHeaderFirstBlock : Cardinal; Operations : TPCOperationsComp) : Boolean;
- Function GetFolder(Const AOrphan : TOrphan): AnsiString;
Function GetBlockHeaderFirstBytePosition(Stream : TStream; Block : Cardinal; CanInitialize : Boolean; var iBlockHeaders : Integer; var BlockHeaderFirstBlock : Cardinal) : Boolean;
Function GetBlockHeaderFixedSize : Int64;
- procedure SetDatabaseFolder(const Value: AnsiString);
Procedure ClearStream;
Procedure GrowStreamUntilPos(Stream : TStream; newPos : Int64; DeleteDataStartingAtCurrentPos : Boolean);
- Function GetPendingBufferOperationsStream : TFileStream;
protected
procedure SetReadOnly(const Value: Boolean); override;
- procedure SetOrphan(const Value: TOrphan); override;
Function DoLoadBlockChain(Operations : TPCOperationsComp; Block : Cardinal) : Boolean; override;
Function DoSaveBlockChain(Operations : TPCOperationsComp) : Boolean; override;
- Function DoMoveBlockChain(Start_Block : Cardinal; Const DestOrphan : TOrphan; DestStorage : TStorage) : Boolean; override;
- Function DoSaveBank : Boolean; override;
- Function DoRestoreBank(max_block : Int64; restoreProgressNotify : TProgressNotify) : Boolean; override;
+ Function DoMoveBlockChain(Start_Block : Cardinal; Const DestOrphan : TOrphan) : Boolean; override;
Procedure DoDeleteBlockChainBlocks(StartingDeleteBlock : Cardinal); override;
Function DoBlockExists(Block : Cardinal) : Boolean; override;
Function LockBlockChainStream : TFileStream;
Procedure UnlockBlockChainStream;
- Function LoadBankFileInfo(Const Filename : AnsiString; var safeBoxHeader : TPCSafeBoxHeader) : Boolean;
function GetFirstBlockNumber: Int64; override;
function GetLastBlockNumber: Int64; override;
function DoInitialize : Boolean; override;
- Function DoOpenSafeBoxCheckpoint(blockCount : Cardinal) : TCheckPointStruct; override;
Procedure DoEraseStorage; override;
- Procedure DoSavePendingBufferOperations(OperationsHashTree : TOperationsHashTree); override;
- Procedure DoLoadPendingBufferOperations(OperationsHashTree : TOperationsHashTree); override;
public
Constructor Create(AOwner : TComponent); Override;
Destructor Destroy; Override;
- Class Function GetSafeboxCheckpointingFileName(Const BaseDataFolder : AnsiString; block : Cardinal) : AnsiString;
- Property DatabaseFolder : AnsiString read FDatabaseFolder write SetDatabaseFolder;
Procedure CopyConfiguration(Const CopyFrom : TStorage); override;
Procedure SetBlockChainFile(BlockChainFileName : AnsiString);
- Function HasUpgradedToVersion2 : Boolean; override;
- Procedure CleanupVersion1Data; override;
- property LowMemoryUsage : Boolean read FLowMemoryUsage write FLowMemoryUsage;
End;
implementation
@@ -160,7 +141,6 @@ function TFileStorage.DoBlockExists(Block: Cardinal): Boolean;
procedure TFileStorage.ClearStream;
begin
FreeAndNil(FBlockChainStream);
- FreeAndNil(FPendingBufferOperationsStream);
FStreamFirstBlockNumber := 0;
FStreamLastBlockNumber := -1;
SetLength(FBlockHeadersFirstBytePosition,0);
@@ -186,46 +166,18 @@ procedure TFileStorage.GrowStreamUntilPos(Stream : TStream; newPos: Int64; Delet
Stream.Position := newPos;
end;
-function TFileStorage.GetPendingBufferOperationsStream: TFileStream;
-Var fs : TFileStream;
- fn : TFileName;
- fm : Word;
-begin
- If Not Assigned(FPendingBufferOperationsStream) then begin
- fn := GetFolder(Orphan)+PathDelim+'pendingbuffer.ops';
- If FileExists(fn) then fm := fmOpenReadWrite+fmShareExclusive
- else fm := fmCreate+fmShareExclusive;
- Try
- FPendingBufferOperationsStream := TFileStream.Create(fn,fm);
- Except
- On E:Exception do begin
- TLog.NewLog(ltError,ClassName,'Error opening PendingBufferOperationsStream '+fn+' ('+E.ClassName+'):'+ E.Message);
- Raise;
- end;
- end;
- end;
- Result := FPendingBufferOperationsStream;
-end;
-
procedure TFileStorage.CopyConfiguration(const CopyFrom: TStorage);
begin
inherited;
- if CopyFrom is TFileStorage then begin
- DatabaseFolder := TFileStorage(CopyFrom).DatabaseFolder;
- end;
end;
constructor TFileStorage.Create(AOwner: TComponent);
begin
inherited;
- FLowMemoryUsage := False;
- FDatabaseFolder := '';
- FBlockChainFileName := '';
FBlockChainStream := Nil;
SetLength(FBlockHeadersFirstBytePosition,0);
FStreamFirstBlockNumber := 0;
FStreamLastBlockNumber := -1;
- FPendingBufferOperationsStream := Nil;
FStorageLock := TPCCriticalSection.Create('TFileStorage_StorageLock');
end;
@@ -278,25 +230,6 @@ function TFileStorage.DoInitialize: Boolean;
End;
end;
-function TFileStorage.DoOpenSafeBoxCheckpoint(blockCount: Cardinal): TCheckPointStruct;
-var fn : TFilename;
- err : AnsiString;
-begin
- Result := Nil;
- fn := GetSafeboxCheckpointingFileName(GetFolder(Orphan),blockCount);
- If (fn<>'') and (FileExists(fn)) then begin
- {$IFDEF USE_ABSTRACTMEM}
- Result := TPCAbstractMem.Create(fn,True);
- {$ELSE}
- Result := TFileStream.Create(fn,fmOpenRead+fmShareDenyWrite);
- {$ENDIF}
- end;
- If Not Assigned(Result) then begin
- err := 'Cannot load SafeBoxStream (block:'+IntToStr(blockCount)+') file:'+fn;
- TLog.NewLog(ltError,ClassName,err);
- end;
-end;
-
procedure TFileStorage.DoEraseStorage;
Var stream : TStream;
begin
@@ -309,43 +242,6 @@ procedure TFileStorage.DoEraseStorage;
end;
end;
-procedure TFileStorage.DoSavePendingBufferOperations(OperationsHashTree : TOperationsHashTree);
-Var fs : TFileStream;
-begin
- LockBlockChainStream;
- Try
- fs := GetPendingBufferOperationsStream;
- fs.Position:=0;
- fs.Size:=0;
- OperationsHashTree.SaveOperationsHashTreeToStream(fs,true);
- {$IFDEF HIGHLOG}TLog.NewLog(ltdebug,ClassName,Format('DoSavePendingBufferOperations operations:%d',[OperationsHashTree.OperationsCount]));{$ENDIF}
- finally
- UnlockBlockChainStream;
- end;
-end;
-
-procedure TFileStorage.DoLoadPendingBufferOperations(OperationsHashTree : TOperationsHashTree);
-Var fs : TFileStream;
- errors : String;
- n : Integer;
- LCurrentProtocol : Word;
-begin
- LockBlockChainStream;
- Try
- fs := GetPendingBufferOperationsStream;
- fs.Position:=0;
- if fs.Size>0 then begin
- if Assigned(Bank) then LCurrentProtocol := Bank.SafeBox.CurrentProtocol
- else LCurrentProtocol := CT_BUILD_PROTOCOL;
- If OperationsHashTree.LoadOperationsHashTreeFromStream(fs,true,LCurrentProtocol,LCurrentProtocol, Nil,errors) then begin
- TLog.NewLog(ltInfo,ClassName,Format('DoLoadPendingBufferOperations loaded operations:%d',[OperationsHashTree.OperationsCount]));
- end else TLog.NewLog(ltError,ClassName,Format('DoLoadPendingBufferOperations ERROR (Protocol %d): loaded operations:%d errors:%s',[LCurrentProtocol,OperationsHashTree.OperationsCount,errors]));
- end;
- finally
- UnlockBlockChainStream;
- end;
-end;
-
function TFileStorage.DoLoadBlockChain(Operations: TPCOperationsComp; Block: Cardinal): Boolean;
Var stream : TStream;
iBlockHeaders : Integer;
@@ -380,52 +276,19 @@ function TFileStorage.DoLoadBlockChain(Operations: TPCOperationsComp; Block: Car
end;
end;
-function TFileStorage.DoMoveBlockChain(Start_Block: Cardinal; const DestOrphan: TOrphan; DestStorage : TStorage): Boolean;
-
- Procedure DoCopySafebox;
- var sr: TSearchRec;
- FileAttrs: Integer;
- folder : AnsiString;
- sourcefn,destfn : AnsiString;
- begin
- FileAttrs := faArchive;
- folder := GetFolder(Orphan);
- if SysUtils.FindFirst(GetFolder(Orphan)+PathDelim+'checkpoint*'+CT_Safebox_Extension, FileAttrs, sr) = 0 then begin
- repeat
- if (sr.Attr and FileAttrs) = FileAttrs then begin
- sourcefn := GetFolder(Orphan)+PathDelim+sr.Name;
- destfn := GetFolder('')+PathDelim+sr.Name;
- TLog.NewLog(ltInfo,ClassName,'Copying safebox file '+sourcefn+' to '+destfn);
- Try
- DoCopyFile(sourcefn,destfn);
- Except
- On E:Exception do begin
- TLog.NewLog(ltError,Classname,'Error copying file: ('+E.ClassName+') '+E.Message);
- end;
- End;
- end;
- until FindNext(sr) <> 0;
- FindClose(sr);
- end;
- End;
-
+function TFileStorage.DoMoveBlockChain(Start_Block: Cardinal; const DestOrphan: TOrphan): Boolean;
Var db : TFileStorage;
i : Integer;
ops : TPCOperationsComp;
b : Cardinal;
begin
Try
- if (Assigned(DestStorage)) And (DestStorage is TFileStorage) then db := TFileStorage(DestStorage)
- else db := Nil;
+ db := TFileStorage.Create(Nil);
try
- if Not assigned(db) then begin
- db := TFileStorage.Create(Nil);
- db.DatabaseFolder := Self.DatabaseFolder;
- db.Bank := Self.Bank;
- db.Orphan := DestOrphan;
- db.FStreamFirstBlockNumber := Start_Block;
- end;
- if db is TFileStorage then TFileStorage(db).LockBlockChainStream;
+ db.Bank := Self.Bank;
+ db.FStreamFirstBlockNumber := Start_Block;
+ db.FStorageFilename := TPCBank.GetStorageFolder(DestOrphan)+PathDelim+'BlockChainStream.blocks';
+ db.LockBlockChainStream;
try
db.FIsMovingBlockchain:=True;
ops := TPCOperationsComp.Create(Nil);
@@ -433,23 +296,19 @@ function TFileStorage.DoMoveBlockChain(Start_Block: Cardinal; const DestOrphan:
b := Start_Block;
while LoadBlockChainBlock(ops,b) do begin
inc(b);
- TLog.NewLog(ltDebug,Classname,'Moving block from "'+Orphan+'" to "'+DestOrphan+'" '+TPCOperationsComp.OperationBlockToText(ops.OperationBlock));
+ TLog.NewLog(ltDebug,Classname,'Moving block from "'+Bank.Orphan+'" to "'+DestOrphan+'" '+TPCOperationsComp.OperationBlockToText(ops.OperationBlock));
db.SaveBlockChainBlock(ops);
end;
- TLog.NewLog(ltdebug,Classname,'Moved blockchain from "'+Orphan+'" to "'+DestOrphan+'" from block '+inttostr(Start_Block)+' to '+inttostr(b-1));
+ TLog.NewLog(ltdebug,Classname,'Moved blockchain from "'+Bank.Orphan+'" to "'+DestOrphan+'" from block '+inttostr(Start_Block)+' to '+inttostr(b-1));
finally
ops.Free;
end;
- // If DestOrphan is empty, then copy possible updated safebox (because, perhaps current saved safebox is from invalid blockchain)
- if (DestOrphan='') And (Orphan<>'') then begin
- DoCopySafebox;
- end;
finally
db.FIsMovingBlockchain:=False;
- if db is TFileStorage then TFileStorage(db).UnlockBlockChainStream;
+ db.UnlockBlockChainStream;
end;
Finally
- If Not Assigned(DestStorage) then db.Free;
+ db.Free;
End;
Except
On E:Exception do begin
@@ -459,160 +318,6 @@ function TFileStorage.DoMoveBlockChain(Start_Block: Cardinal; const DestOrphan:
End;
end;
-function TFileStorage.DoRestoreBank(max_block: Int64; restoreProgressNotify : TProgressNotify): Boolean;
-var
- sr: TSearchRec;
- FileAttrs: Integer;
- folder : AnsiString;
- Lfilename,auxfn : AnsiString;
- fs : TFileStream;
- ms : TMemoryStream;
- errors : String;
- LBlockscount : Cardinal;
- sbHeader, goodSbHeader : TPCSafeBoxHeader;
- {$IFDEF USE_ABSTRACTMEM}
- LTempBlocksCount : Integer;
- LSafeboxFileName : String;
- {$ELSE}
- {$ENDIF}
-begin
- LockBlockChainStream;
- Try
- {$IFDEF USE_ABSTRACTMEM}
- Lfilename := '';
- LSafeboxFileName := GetFolder(Orphan)+PathDelim+'safebox'+CT_Safebox_Extension;
- if TPCAbstractMem.AnalyzeFile(LSafeboxFileName,LTempBlocksCount) then begin
- LBlockscount := LTempBlocksCount;
- end else begin
- LBlockscount := 0;
- end;
- //
- FileAttrs := faArchive;
- folder := GetFolder(''); /// Without Orphan folder
- if SysUtils.FindFirst(folder+PathDelim+'checkpoint*'+CT_Safebox_Extension, FileAttrs, sr) = 0 then begin
- repeat
- if (sr.Attr and FileAttrs) = FileAttrs then begin
- auxfn := folder+PathDelim+sr.Name;
- if TPCAbstractMem.AnalyzeFile(auxfn,LTempBlocksCount) then begin
- if (((max_block<0) Or (LTempBlocksCount<=max_block)) AND (LTempBlocksCount>LBlockscount)) then begin
- Lfilename := auxfn;
- LBlockscount := LTempBlocksCount;
- end;
- end;
- end;
- until FindNext(sr) <> 0;
- FindClose(sr);
- end;
- if (Lfilename='') then begin
- Bank.SafeBox.SetSafeboxFileName(LSafeboxFileName);
- end else begin
- Bank.SafeBox.SetSafeboxFileName(Lfilename);
- Bank.SafeBox.UpdateSafeboxFileName(LSafeboxFileName);
- end;
- {$ELSE}
- LBlockscount := 0;
- {$ENDIF}
- FileAttrs := faArchive;
- folder := GetFolder(Orphan);
- Lfilename := '';
- if SysUtils.FindFirst(folder+PathDelim+'*.safebox', FileAttrs, sr) = 0 then begin
- repeat
- if (sr.Attr and FileAttrs) = FileAttrs then begin
- auxfn := folder+PathDelim+sr.Name;
- If LoadBankFileInfo(auxfn,sbHeader) then begin
- if (((max_block<0) Or (sbHeader.endBlock<=max_block)) AND (sbHeader.blocksCount>LBlockscount)) And
- (sbHeader.startBlock=0) And (sbHeader.endBlock=sbHeader.startBlock+sbHeader.blocksCount-1) then begin
- Lfilename := auxfn;
- LBlockscount := sbHeader.blocksCount;
- goodSbHeader := sbHeader;
- end;
- end;
- end;
- until FindNext(sr) <> 0;
- FindClose(sr);
- end;
- if (Lfilename<>'') then begin
- TLog.NewLog(ltinfo,Self.ClassName,'Loading SafeBox protocol:'+IntToStr(goodSbHeader.protocol)+' with '+inttostr(LBlockscount)+' blocks from file '+Lfilename+' LowMemoryUsage:'+LowMemoryUsage.ToString(True));
- fs := TFileStream.Create(Lfilename,fmOpenRead);
- try
- fs.Position := 0;
- if LowMemoryUsage then begin
- if not Bank.LoadBankFromStream(fs,False,Nil,Nil,restoreProgressNotify,errors) then begin
- TLog.NewLog(lterror,ClassName,'Error reading bank from file: '+Lfilename+ ' Error: '+errors);
- end;
- end else begin
- ms := TMemoryStream.Create;
- Try
- ms.CopyFrom(fs,0);
- ms.Position := 0;
- if not Bank.LoadBankFromStream(ms,False,Nil,Nil,restoreProgressNotify,errors) then begin
- TLog.NewLog(lterror,ClassName,'Error reading bank from file: '+Lfilename+ ' Error: '+errors);
- end;
- Finally
- ms.Free;
- End;
- end;
- finally
- fs.Free;
- end;
- end;
- Finally
- UnlockBlockChainStream;
- End;
-end;
-
-function TFileStorage.DoSaveBank: Boolean;
-var fs: TFileStream;
- bankfilename,aux_newfilename: AnsiString;
- ms : TMemoryStream;
- LTC : TTickCount;
-begin
- Result := true;
- bankfilename := GetSafeboxCheckpointingFileName(GetFolder(Orphan),Bank.BlocksCount);
- if (bankfilename<>'') then begin
- LTC := TPlatform.GetTickCount;
- {$IFDEF USE_ABSTRACTMEM}
- Bank.SafeBox.SaveCheckpointing(bankfilename);
- {$ELSE}
- fs := TFileStream.Create(bankfilename,fmCreate);
- try
- fs.Size := 0;
- fs.Position:=0;
- if LowMemoryUsage then begin
- Bank.SafeBox.SaveSafeBoxToAStream(fs,0,Bank.SafeBox.BlocksCount-1);
- end else begin
- ms := TMemoryStream.Create;
- try
- Bank.SafeBox.SaveSafeBoxToAStream(ms,0,Bank.SafeBox.BlocksCount-1);
- ms.Position := 0;
- fs.CopyFrom(ms,0);
- finally
- ms.Free;
- end;
- end;
- finally
- fs.Free;
- end;
- {$ENDIF}
- TLog.NewLog(ltInfo,ClassName,Format('Saving Safebox blocks:%d file:%s in %.2n seconds',[Bank.BlocksCount,bankfilename,TPlatform.GetElapsedMilliseconds(LTC)/1000]));
- // Save a copy each 10000 blocks (aprox 1 month) only when not an orphan
- if (Orphan='') And ((Bank.BlocksCount MOD (CT_BankToDiskEveryNBlocks*100))=0) then begin
- aux_newfilename := GetFolder('') + PathDelim+'checkpoint_'+ inttostr(Bank.BlocksCount)+CT_Safebox_Extension;
- try
- {$IFDEF FPC}
- DoCopyFile(bankfilename,aux_newfilename);
- {$ELSE}
- CopyFile(PWideChar(bankfilename),PWideChar(aux_newfilename),False);
- {$ENDIF}
- Except
- On E:Exception do begin
- TLog.NewLog(lterror,ClassName,'Exception copying extra safebox file '+aux_newfilename+' ('+E.ClassName+'):'+E.Message);
- end;
- end;
- end;
- end;
-end;
-
function TFileStorage.DoSaveBlockChain(Operations: TPCOperationsComp): Boolean;
Var stream : TStream;
iBlockHeaders : Integer;
@@ -634,23 +339,11 @@ function TFileStorage.DoSaveBlockChain(Operations: TPCOperationsComp): Boolean;
Finally
UnlockBlockChainStream;
End;
- if Assigned(Bank) then SaveBank(False);
+ if Assigned(Bank) then Bank.SaveBank(False);
end;
Const CT_SafeboxsToStore = 10;
-class function TFileStorage.GetSafeboxCheckpointingFileName(const BaseDataFolder: AnsiString; block: Cardinal): AnsiString;
-begin
- Result := '';
- If not ForceDirectories(BaseDataFolder) then exit;
- if TPCSafeBox.MustSafeBoxBeSaved(block) then begin
- // We will store checkpointing
- Result := BaseDataFolder + PathDelim+'checkpoint'+ inttostr((block DIV CT_BankToDiskEveryNBlocks) MOD CT_SafeboxsToStore)+CT_Safebox_Extension;
- end else begin
- Result := BaseDataFolder + PathDelim+'checkpoint_'+inttostr(block)+CT_Safebox_Extension;
- end;
-end;
-
function TFileStorage.GetBlockHeaderFirstBytePosition(Stream : TStream; Block: Cardinal; CanInitialize : Boolean; var iBlockHeaders : Integer; var BlockHeaderFirstBlock: Cardinal): Boolean;
var iPos,start, nCurrBlock : Cardinal;
bh : TBlockHeader;
@@ -750,34 +443,11 @@ function TFileStorage.GetFirstBlockNumber: Int64;
Result := FStreamFirstBlockNumber;
end;
-function TFileStorage.GetFolder(const AOrphan: TOrphan): AnsiString;
-begin
- if FDatabaseFolder = '' then raise Exception.Create('No Database Folder');
- if AOrphan<>'' then Result := FDatabaseFolder + PathDelim+AOrphan
- else Result := FDatabaseFolder;
- if not ForceDirectories(Result) then raise Exception.Create('Cannot create database folder: '+Result);
-end;
-
function TFileStorage.GetLastBlockNumber: Int64;
begin
Result := FStreamLastBlockNumber;
end;
-function TFileStorage.LoadBankFileInfo(const Filename: AnsiString; var safeBoxHeader : TPCSafeBoxHeader) : Boolean;
-var fs: TFileStream;
-begin
- Result := false;
- safeBoxHeader := CT_PCSafeBoxHeader_NUL;
- If Not FileExists(Filename) then exit;
- fs := TFileStream.Create(Filename,fmOpenRead);
- try
- fs.Position:=0;
- Result := Bank.SafeBox.LoadSafeBoxStreamHeader(fs,safeBoxHeader);
- finally
- fs.Free;
- end;
-end;
-
function TFileStorage.LockBlockChainStream: TFileStream;
function InitStreamInfo(Stream : TStream; var errors : String) : Boolean;
Var mem : TStream;
@@ -906,10 +576,11 @@ function TFileStorage.LockBlockChainStream: TFileStream;
TPCThread.ProtectEnterCriticalSection(Self,FStorageLock);
Try
if Not Assigned(FBlockChainStream) then begin
- if FBlockChainFileName<>'' then begin
- fn := FBlockChainFileName
+ if FStorageFilename<>'' then begin
+ fn := FStorageFilename
end else begin
- fn := GetFolder(Orphan)+PathDelim+'BlockChainStream.blocks';
+ fn := TPCBank.GetStorageFolder(Orphan)+PathDelim+'BlockChainStream.blocks';
+ FStorageFilename := fn;
end;
exists := FileExists(fn);
if ReadOnly then begin
@@ -938,20 +609,7 @@ function TFileStorage.LockBlockChainStream: TFileStream;
procedure TFileStorage.SetBlockChainFile(BlockChainFileName: AnsiString);
begin
ClearStream;
- FBlockChainFileName := BlockChainFileName;
-end;
-
-procedure TFileStorage.SetDatabaseFolder(const Value: AnsiString);
-begin
- if FDatabaseFolder=Value then exit;
- FDatabaseFolder := Value;
- ClearStream;
-end;
-
-procedure TFileStorage.SetOrphan(const Value: TOrphan);
-begin
- inherited;
- ClearStream;
+ FStorageFilename := BlockChainFileName;
end;
procedure TFileStorage.SetReadOnly(const Value: Boolean);
@@ -1135,24 +793,4 @@ procedure TFileStorage.UnlockBlockChainStream;
FStorageLock.Release;
end;
-function TFileStorage.HasUpgradedToVersion2: Boolean;
-var searchRec: TSearchRec;
-begin
- HasUpgradedToVersion2 := SysUtils.FindFirst( GetFolder(Orphan)+PathDelim+'*'+CT_Safebox_Extension, faArchive, searchRec) = 0;
- FindClose(searchRec);
-end;
-
-procedure TFileStorage.CleanupVersion1Data;
-var
- folder : AnsiString;
- searchRec : TSearchRec;
-begin
- folder := GetFolder(Orphan);
- if SysUtils.FindFirst( folder+PathDelim+'*.bank', faArchive, searchRec) = 0 then
- repeat
- SysUtils.DeleteFile(folder+PathDelim+searchRec.Name);
- until FindNext(searchRec) <> 0;
- FindClose(searchRec);
-end;
-
end.
diff --git a/src/core/ULog.pas b/src/core/ULog.pas
index 0cc02cd06..90d3bd331 100644
--- a/src/core/ULog.pas
+++ b/src/core/ULog.pas
@@ -123,7 +123,9 @@ destructor TLog.Destroy;
FThreadSafeLogEvent.Terminate;
FThreadSafeLogEvent.WaitFor;
FreeAndNil(FThreadSafeLogEvent);
- _logs.Remove(Self);
+ if Assigned(_logs) then begin
+ _logs.Remove(Self);
+ end;
FreeAndNil(FFileStream);
l := FLogDataList.LockList;
try
@@ -164,7 +166,7 @@ procedure TLog.NotifyNewLog(logtype: TLogType; Const sender, logtext: String);
try
if assigned(FFileStream) And (logType in FSaveTypes) then begin
if TThread.CurrentThread.ThreadID=MainThreadID then tid := ' MAIN:' else tid:=' TID:';
- s := FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz',now)+tid+IntToHex(PtrInt(TThread.CurrentThread.ThreadID),8)+' ['+CT_LogType[logtype]+'] <'+sender+'> '+logtext+#13#10;
+ s := FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz',now)+tid+PtrInt(TThread.CurrentThread.ThreadID).ToHexString+' ['+CT_LogType[logtype]+'] <'+sender+'> '+logtext+#13#10;
FFileStream.Write(s[Low(s)],Length(s));
end;
if Assigned(FOnInThreadNewLog) then begin
diff --git a/src/core/UNetProtocol.pas b/src/core/UNetProtocol.pas
index 68ea2c98e..4822edef8 100644
--- a/src/core/UNetProtocol.pas
+++ b/src/core/UNetProtocol.pas
@@ -36,7 +36,7 @@ interface
UPCDataTypes,
{$IFNDEF FPC}System.Generics.Collections,System.Generics.Defaults
{$ELSE}Generics.Collections,Generics.Defaults{$ENDIF},
- {$IFDEF USE_ABSTRACTMEM}UPCAbstractMem,{$ENDIF}
+ {$IFDEF USE_ABSTRACTMEM}UPCAbstractMem, UAbstractMemBlockchainStorage,{$ENDIF}
UNetProtection;
Const
@@ -164,7 +164,8 @@ interface
Function LockList : TList;
Procedure UnlockList;
procedure ResetConnectAttempts;
- function IsBlackListed(const ip: String): Boolean;
+ function IsBlackListed(const ip: String; out AReason : string): Boolean; overload;
+ function IsBlackListed(const ip: String): Boolean; overload;
function GetNodeServerAddress(const ip : String; port:Word; CanAdd : Boolean; var nodeServerAddress : TNodeServerAddress) : Boolean;
procedure SetNodeServerAddress(const nodeServerAddress : TNodeServerAddress);
Procedure UpdateNetConnection(netConnection : TNetConnection);
@@ -302,6 +303,7 @@ interface
procedure SetMinServersConnected(AValue: Integer);
procedure SetNetConnectionsActive(const Value: Boolean);
procedure SetMinFutureBlocksToDownloadNewSafebox(const Value: Integer);
+ procedure OnDownloadingSafeboxProgressNotify(sender : TObject; const mesage : String; curPos, totalCount : Int64);
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
Procedure DiscoverServersTerminated(Sender : TObject);
@@ -420,7 +422,6 @@ interface
Procedure DoProcess_GetPendingOperations;
Procedure SetClient(Const Value : TNetTcpIpClient);
Function ReadTcpClientBuffer(MaxWaitMiliseconds : Cardinal; var HeaderData : TNetHeaderData; BufferData : TStream) : Boolean;
- Procedure DisconnectInvalidClient(ItsMyself : Boolean; Const why : String);
function GetClient: TNetTcpIpClient;
protected
Procedure Send(NetTranferType : TNetTransferType; operation, errorcode : Word; request_id : Integer; DataBuffer : TStream);
@@ -434,6 +435,7 @@ interface
Function ConnectTo(ServerIP: String; ServerPort:Word) : Boolean;
Property Connected : Boolean read GetConnected write SetConnected;
Property IsConnecting : Boolean read FIsConnecting;
+ Procedure DisconnectInvalidClient(ItsMyself : Boolean; Const why : String);
Function Send_Hello(NetTranferType : TNetTransferType; request_id : Integer) : Boolean;
Function Send_NewBlockFound(Const NewBlock : TPCOperationsComp) : Boolean;
Function Send_GetBlocks(StartAddress, quantity : Cardinal; var request_id : Cardinal) : Boolean;
@@ -512,7 +514,7 @@ implementation
uses
UConst, ULog, UNode, UTime, UPCEncryption, UChunk,
- UPCOperationsBlockValidator, UPCOperationsSignatureValidator,
+ UPCOperationsBlockValidator, UPCOperationsSignatureValidator, UOpTransaction, UPCDownloadSafebox,
UPCTemporalFileStream;
Const
@@ -821,11 +823,12 @@ function TOrderedServerAddressListTS.GetValidNodeServers(OnlyWhereIConnected: Bo
end;
end;
-function TOrderedServerAddressListTS.IsBlackListed(const ip: String): Boolean;
+function TOrderedServerAddressListTS.IsBlackListed(const ip: String; out AReason : string): Boolean;
Var i : Integer;
P : PNodeServerAddress;
begin
Result := false;
+ AReason := '';
FCritical.Acquire;
Try
SecuredFindByIp(ip,0,i);
@@ -835,6 +838,7 @@ function TOrderedServerAddressListTS.IsBlackListed(const ip: String): Boolean;
if Not SameStr(P^.ip,ip) then exit;
if P^.is_blacklisted then begin
Result := Not P^.its_myself;
+ AReason := P^.BlackListText;
end;
inc(i);
end;
@@ -843,6 +847,12 @@ function TOrderedServerAddressListTS.IsBlackListed(const ip: String): Boolean;
End;
end;
+function TOrderedServerAddressListTS.IsBlackListed(const ip: String): Boolean;
+var LReason : String;
+begin
+ Result := IsBlackListed(ip,LReason);
+end;
+
function TOrderedServerAddressListTS.LockList: TList;
begin
FCritical.Acquire;
@@ -1243,7 +1253,12 @@ destructor TNetData.Destroy;
tdc : TThreadDiscoverConnection;
begin
TLog.NewLog(ltInfo,ClassName,'TNetData.Destroy START');
+ {$IFDEF DELPHI_SYDNEY_PLUS }
+ SetLength(FOnConnectivityChanged.Handlers, 0);
+ SetLength(FOnConnectivityChanged.MainThreadHandlers, 0);
+ {$ELSE}
FreeAndNil(FOnConnectivityChanged);
+ {$ENDIF}
FOnGetNewBlockchainFromClientDownloadNewSafebox := Nil;
FOnStatisticsChanged := Nil;
FOnNetConnectionsUpdated := Nil;
@@ -1644,9 +1659,9 @@ procedure TNetData.GetNewBlockChainFromClient(Connection: TNetConnection;
Bank := TPCBank.Create(Nil);
try
Bank.StorageClass := TNode.Node.Bank.StorageClass;
- Bank.Storage.Orphan := TNode.Node.Bank.Storage.Orphan;
- Bank.Storage.ReadOnly := true;
+ Bank.Orphan := TNode.Node.Bank.Orphan;
Bank.Storage.CopyConfiguration(TNode.Node.Bank.Storage);
+ Bank.Storage.ReadOnly := true;
if start_block>=0 then begin
@@ -1656,18 +1671,19 @@ procedure TNetData.GetNewBlockChainFromClient(Connection: TNetConnection;
Bank.UpdateValuesFromSafebox;
IsUsingSnapshot := True;
- Bank.Storage.Orphan := FormatDateTime('yyyymmddhhnnss',DateTime2UnivDateTime(now));
+ Bank.Orphan := FormatDateTime('yyyymmddhhnnss',DateTime2UnivDateTime(now));
+ Bank.Storage.StorageFilename := '';
Bank.Storage.ReadOnly := false;
end else begin
{$IFDEF USE_ABSTRACTMEM}
- Bank.Storage.Orphan := FormatDateTime('yyyymmddhhnnss',DateTime2UnivDateTime(now));
+ Bank.Orphan := FormatDateTime('yyyymmddhhnnss',DateTime2UnivDateTime(now));
Bank.Storage.ReadOnly := false;
{$ENDIF}
// Restore a part from disk
Bank.DiskRestoreFromOperations(start_block-1);
- Bank.Storage.SaveBank(True);
+ Bank.SaveBank(True);
if (Bank.BlocksCount Note: Maximum is CT_MAX_SAFEBOXCHUNK_BLOCKS
- for i:=0 to ((LDownloadedSafeboxBlocksCount-1) DIV 10000) do begin // Bug v3.0.1 and minors
- FNewBlockChainFromClientStatus := Format('Receiving new safebox with %d blocks (step %d/%d) from %s',
- [LDownloadedSafeboxBlocksCount,i+1,((LDownloadedSafeboxBlocksCount-1) DIV 10000)+1,Connection.ClientRemoteAddr]);
- LreceivedChunk := TPCTemporalFileStream.Create(Format('CHUNK_%.3d_',[i]));
- if (Not DownloadSafeBoxChunk(LDownloadedSafeboxBlocksCount,ASafeboxLastOperationBlock.initial_safe_box_hash,(i*10000),((i+1)*10000)-1,LreceivedChunk,safeBoxHeader,errors)) then begin
- LreceivedChunk.Free;
- TLog.NewLog(ltError,CT_LogSender,errors);
- Exit;
- end;
- try
- LreceivedChunk.Position := 0;
- ASafeboxChunks.AddChunk( LreceivedChunk );
- Except
- On E:Exception do begin
- errors:= Format('(%s) %s',[E.ClassName,E.Message]);
- Result := false;
- LreceivedChunk.Free;
- Exit;
- end;
- end;
- end;
- if Not ASafeboxChunks.IsComplete then begin
- errors := 'Safebox Chunks is not complete!';
- Exit;
- end else Result := True;
+ LdownSafebox := TPCDownloadSafebox.Create;
+ Try
+ LdownSafebox.OnProgressNotify := OnDownloadingSafeboxProgressNotify;
+ Result := LdownSafebox.DownloadSafebox(TThread.CurrentThread,ASafeboxLastOperationBlock,ASafeboxChunks);
+ finally
+ LdownSafebox.Free;
+ end;
+
end;
@@ -1957,7 +1955,7 @@ procedure TNetData.GetNewBlockChainFromClient(Connection: TNetConnection;
If Not IsMyBlockchainValid then begin
TNode.Node.Bank.Storage.EraseStorage;
end;
- TNode.Node.Bank.Storage.SaveBank(False);
+ TNode.Node.Bank.SaveBank(False);
Connection.Send_GetBlocks(TNode.Node.Bank.BlocksCount,100,request_id);
Result := true;
end else begin
@@ -2000,16 +1998,16 @@ procedure TNetData.GetNewBlockChainFromClient(Connection: TNetConnection;
newTmpBank := TPCBank.Create(Nil);
try
newTmpBank.StorageClass := TNode.Node.Bank.StorageClass;
- newTmpBank.Storage.Orphan := TNode.Node.Bank.Storage.Orphan;
+ newTmpBank.Orphan := TNode.Node.Bank.Orphan;
newTmpBank.Storage.ReadOnly := true;
newTmpBank.Storage.CopyConfiguration(TNode.Node.Bank.Storage);
- newTmpBank.Storage.Orphan := FormatDateTime('yyyymmddhhnnss',DateTime2UnivDateTime(now));
+ newTmpBank.Orphan := FormatDateTime('yyyymmddhhnnss',DateTime2UnivDateTime(now));
newTmpBank.Storage.ReadOnly := false;
If newTmpBank.LoadBankFromChunks(LChunks,LSafeboxLastOperationBlock.initial_safe_box_hash,TNode.Node.Bank.SafeBox,OnReadingNewSafeboxProgressNotify,errors) then begin
TNode.Node.DisableNewBlocks;
try
TLog.NewLog(ltInfo,ClassName,'Received new safebox!');
- newTmpBank.Storage.SaveBank(True); // Saving bank
+ newTmpBank.SaveBank(True); // Saving bank
// Receive at least 1 new block
blocksList := TList.Create;
try
@@ -2291,6 +2289,14 @@ procedure TNetData.NotifyStatisticsChanged;
FNetDataNotifyEventsThread.FNotifyOnStatisticsChanged := true;
end;
+procedure TNetData.OnDownloadingSafeboxProgressNotify(sender: TObject;
+ const mesage: String; curPos, totalCount: Int64);
+Var pct : String;
+begin
+ if (totalCount>0) then pct := FormatFloat('0.00',curPos*100/totalCount)+'%' else pct := '';
+ FNewBlockChainFromClientStatus := Format('%s %s',[mesage,pct]);
+end;
+
procedure TNetData.OnReadingNewSafeboxProgressNotify(sender: TObject; const mesage: String; curPos, totalCount: Int64);
Var pct : String;
begin
@@ -2412,7 +2418,7 @@ constructor TNetServer.Create;
procedure TNetServer.OnNewIncommingConnection(Sender : TObject; Client : TNetTcpIpClient);
Var n : TNetServerClient;
- DebugStep : String;
+ DebugStep, LReason : String;
tc : TTickCount;
begin
DebugStep := '';
@@ -2428,10 +2434,10 @@ procedure TNetServer.OnNewIncommingConnection(Sender : TObject; Client : TNetTcp
TNetData.NetData.IncStatistics(1,1,0,0,0,0);
TNetData.NetData.NodeServersAddresses.CleanBlackList(False);
DebugStep := 'Checking blacklisted';
- if (TNetData.NetData.NodeServersAddresses.IsBlackListed(Client.RemoteHost)) then begin
+ if (TNetData.NetData.NodeServersAddresses.IsBlackListed(Client.RemoteHost,LReason)) then begin
// Invalid!
TLog.NewLog(ltinfo,Classname,'Refusing Blacklist ip: '+Client.ClientRemoteAddr);
- n.SendError(ntp_autosend,CT_NetOp_Error, 0,CT_NetError_IPBlackListed,'Your IP is blacklisted:'+Client.ClientRemoteAddr);
+ n.SendError(ntp_autosend,CT_NetOp_Error, 0,CT_NetError_IPBlackListed,'Your IP is blacklisted:'+Client.ClientRemoteAddr+' '+LReason);
// Wait some time before close connection
sleep(5000);
end else begin
@@ -2704,6 +2710,7 @@ procedure TNetConnection.DoProcess_AddOperations(HeaderData: TNetHeaderData; Dat
operations : TOperationsHashTree;
errors : String;
DoDisconnect : Boolean;
+ Lopc,Lprc : Integer;
begin
DoDisconnect := true;
operations := TOperationsHashTree.Create;
@@ -2712,30 +2719,9 @@ procedure TNetConnection.DoProcess_AddOperations(HeaderData: TNetHeaderData; Dat
errors := 'Not autosend';
exit;
end;
- if (NetProtocolVersion.protocol_available>=10) then begin
- if Not operations.LoadOperationsHashTreeFromStream(DataBuffer,False,TNode.Node.Bank.SafeBox.CurrentProtocol,TNode.Node.Bank.SafeBox.CurrentProtocol,Nil,errors) then Exit;
- end else begin
- // TODO:
- // After V5 Activation all this code can be deleted, not used anymore
- if DataBuffer.Size<4 then begin
- errors := 'Invalid databuffer size';
- exit;
- end;
- DataBuffer.Read(c,4);
- for i := 1 to c do begin
- errors := 'Invalid operation '+inttostr(i)+'/'+inttostr(c);
- if not DataBuffer.Read(optype,1)=1 then exit;
- opclass := TPCOperationsComp.GetOperationClassByOpType(optype);
- if Not Assigned(opclass) then exit;
- op := opclass.Create(TNode.Node.Bank.SafeBox.CurrentProtocol);
- Try
- op.LoadFromNettransfer(DataBuffer);
- operations.AddOperationToHashTree(op);
- Finally
- op.Free;
- End;
- end;
- end;
+ if Not operations.LoadOperationsHashTreeFromStream(DataBuffer,False,
+ TNode.Node.Bank.SafeBox.CurrentProtocol,TNode.Node.Bank.SafeBox.CurrentProtocol,Nil,
+ CT_AllowPropagate0feeOperations,Lopc,Lprc,errors) then Exit;
DoDisconnect := false;
finally
try
@@ -2964,8 +2950,15 @@ procedure TNetConnection.DoProcess_GetBlocks_Response(HeaderData: TNetHeaderData
DoDisconnect : Boolean;
LBlocks : TList;
LSafeboxTransaction : TPCSafeBoxTransaction;
+ LPrevious : Boolean;
begin
DoDisconnect := true;
+ {$IFDEF USE_ABSTRACTMEM}
+ if (TNode.Node.Bank.Storage is TAbstractMemBlockchainStorage) then begin
+ LPrevious := TAbstractMemBlockchainStorage( TNode.Node.Bank.Storage ).AutoFlushCache;
+ TAbstractMemBlockchainStorage( TNode.Node.Bank.Storage ).AutoFlushCache := False;
+ end;
+ {$ENDIF}
try
if HeaderData.header_type<>ntp_response then begin
errors := 'Not response';
@@ -3033,9 +3026,10 @@ procedure TNetConnection.DoProcess_GetBlocks_Response(HeaderData: TNetHeaderData
end;
sleep(1);
end;
+
FIsDownloadingBlocks := false;
if ((LOpCount>0) And (FRemoteOperationBlock.block>=TNode.Node.Bank.BlocksCount)) then begin
- Send_GetBlocks(TNode.Node.Bank.BlocksCount,100,c);
+ Send_GetBlocks(TNode.Node.Bank.BlocksCount,100+Random(300),c);
end else begin
// No more blocks to download, download Pending operations
DoProcess_GetPendingOperations;
@@ -3051,6 +3045,15 @@ procedure TNetConnection.DoProcess_GetBlocks_Response(HeaderData: TNetHeaderData
if DoDisconnect then begin
DisconnectInvalidClient(false,errors+' > '+TNetData.HeaderDataToText(HeaderData)+' BuffSize: '+inttostr(DataBuffer.Size));
end;
+ {$IFDEF USE_ABSTRACTMEM}
+ TNode.Node.Bank.SafeBox.PCAbstractMem.FlushCache;
+ if (TNode.Node.Bank.Storage is TAbstractMemBlockchainStorage) then begin
+ TAbstractMemBlockchainStorage( TNode.Node.Bank.Storage ).AutoFlushCache := LPrevious;
+ if TAbstractMemBlockchainStorage( TNode.Node.Bank.Storage ).PendingToSave = 0 then begin
+ TAbstractMemBlockchainStorage( TNode.Node.Bank.Storage ).FileMem.FlushCache;
+ end;
+ end;
+ {$ENDIF}
end;
end;
@@ -3164,7 +3167,7 @@ procedure TNetConnection.DoProcess_GetSafeBox_Request(HeaderData: TNetHeaderData
responseStream := TMemoryStream.Create;
try
{$IFDEF USE_ABSTRACTMEM}
- Labstracmem := TNode.Node.Bank.Storage.OpenSafeBoxCheckpoint(_blockcount);
+ Labstracmem := TNode.Node.Bank.OpenSafeBoxCheckpoint(_blockcount);
try
If Not Assigned(Labstracmem) then begin
SendError(ntp_response,HeaderData.operation,CT_NetError_SafeboxNotFound,HeaderData.request_id,Format('Safebox stream file for block %d not found',[_blockcount]));
@@ -3314,7 +3317,7 @@ procedure TNetConnection.DoProcess_GetPendingOperations;
headerData : TNetHeaderData;
opht : TOperationsHashTree;
errors : String;
- i : Integer;
+ i,Lopc,Lprc : Integer;
begin
{$IFDEF PRODUCTION}
If FNetProtocolVersion.protocol_available<=6 then Exit; // Note: GetPendingOperations started on protocol_available=7
@@ -3361,7 +3364,10 @@ procedure TNetConnection.DoProcess_GetPendingOperations;
//
opht := TOperationsHashTree.Create;
try
- If Not opht.LoadOperationsHashTreeFromStream(dataReceived,False,FRemoteOperationBlock.protocol_version,FRemoteOperationBlock.protocol_version,Nil,errors) then begin
+ If Not opht.LoadOperationsHashTreeFromStream(dataReceived,False,
+ FRemoteOperationBlock.protocol_version,FRemoteOperationBlock.protocol_version,Nil,
+ CT_AllowPropagate0feeOperations,Lopc,Lprc,errors)
+ then begin
DisconnectInvalidClient(False,'Invalid operations hash tree stream: '+errors);
Exit;
end;
@@ -3388,7 +3394,7 @@ procedure TNetConnection.DoProcess_GetPendingOperations;
procedure TNetConnection.DoProcess_GetPubkeyAccounts_Request(HeaderData: TNetHeaderData; DataBuffer: TStream);
Const CT_Max_Accounts_per_call = 1000;
var responseStream, accountsStream : TMemoryStream;
- start,max : Integer;
+ start,max,i : Integer;
c, nAccounts : Cardinal;
acc : TAccount;
DoDisconnect : Boolean;
@@ -3396,6 +3402,7 @@ procedure TNetConnection.DoProcess_GetPubkeyAccounts_Request(HeaderData: TNetHea
pubKey : TAccountKey;
sbakl : TSafeboxPubKeysAndAccounts;
ocl : TAccountsNumbersList;
+ LAccountsList : TList;
begin
{
This call is used to obtain Accounts used by a Public key
@@ -3442,15 +3449,19 @@ procedure TNetConnection.DoProcess_GetPubkeyAccounts_Request(HeaderData: TNetHea
if Assigned(sbakl) then begin
ocl := sbakl.GetAccountsUsingThisKey(pubKey);
if Assigned(ocl) then begin
- while (start0) do begin
- acc := TNode.Node.GetMempoolAccount(ocl.Get(start));
- if (HeaderData.protocol.protocol_available>9) then
- TAccountComp.SaveAccountToAStream(accountsStream,acc,CT_PROTOCOL_5)
- else
- TAccountComp.SaveAccountToAStream(accountsStream,acc,CT_PROTOCOL_4);
- inc(nAccounts);
- inc(start);
- dec(max);
+ LAccountsList := TList.Create;
+ try
+ ocl.FillList(start,max,LAccountsList);
+ for i := 0 to LaccountsList.Count-1 do begin
+ acc := TNode.Node.GetMempoolAccount(LAccountsList[i]);
+ if (HeaderData.protocol.protocol_available>9) then
+ TAccountComp.SaveAccountToAStream(accountsStream,acc,CT_PROTOCOL_5)
+ else
+ TAccountComp.SaveAccountToAStream(accountsStream,acc,CT_PROTOCOL_4);
+ end;
+ nAccounts := LaccountsList.Count;
+ finally
+ LaccountsList.Free;
end;
end;
// Save & send
@@ -3911,8 +3922,13 @@ procedure TNetConnection.DoProcess_NewBlock(AHeaderData: TNetHeaderData; DataBuf
If Not TAccountComp.EqualOperationBlocks(operationsComp.OperationBlock,original_OperationBlock) then begin
// This can happen when a OpReference in my MEMPOOL is different to an OpReference in the miner, causing different OperationsHash value
// This means a possible double spend found
- TLog.NewLog(lterror,ClassName,Format('Constructed a distinct FAST PROPAGATION block with my mempool operations. Received: %s Constructed: %s',
+ if Not operationsComp.OperationsHashTree.HasOpRecoverOperations then begin
+ TLog.NewLog(lterror,ClassName,Format('Constructed a distinct FAST PROPAGATION block with my mempool operations. Received: %s Constructed: %s',
[TPCOperationsComp.OperationBlockToText(original_OperationBlock),TPCOperationsComp.OperationBlockToText(operationsComp.OperationBlock)]));
+ end else begin
+ TLog.NewLog(lterror,ClassName,Format('Constructed a distinct FAST PROPAGATION block with my mempool operations. Posible double-spend attempt. Received: %s Constructed: %s',
+ [TPCOperationsComp.OperationBlockToText(original_OperationBlock),TPCOperationsComp.OperationBlockToText(operationsComp.OperationBlock)]));
+ end;
if Not TPCSafeBox.IsValidOperationBlock(original_OperationBlock,errors) then begin
// This means a scammer!
DoDisconnect := True;
@@ -4431,7 +4447,7 @@ function TNetConnection.Send_AddOperations(Operations : TOperationsHashTree) : B
nOpsToSend := Operations.OperationsCount;
end;
if FBufferToSendOperations.OperationsCount>0 then begin
- TLog.NewLog(ltdebug,ClassName,Format('Sending %d Operations to %s (inProc:%d, Received:%d)',[FBufferToSendOperations.OperationsCount,ClientRemoteAddr,nOpsToSend,FBufferReceivedOperationsHash.Count]));
+ {$IFDEF HIGHLOG}TLog.NewLog(ltdebug,ClassName,Format('Sending %d Operations to %s (inProc:%d, Received:%d)',[FBufferToSendOperations.OperationsCount,ClientRemoteAddr,nOpsToSend,FBufferReceivedOperationsHash.Count]));{$ENDIF}
LStream := TMemoryStream.Create;
try
request_id := TNetData.NetData.NewRequestId;
@@ -4623,8 +4639,12 @@ function TNetConnection.Send_NewBlockFound(const NewBlock: TPCOperationsComp): B
data := TMemoryStream.Create;
try
request_id := TNetData.NetData.NewRequestId;
- // Will send a FAST PROPAGATION BLOCK as described at PIP-0015
- netOp := CT_NetOp_NewBlock_Fast_Propagation;
+ if (NewBlock.OperationsHashTree.HasOpRecoverOperations) then begin
+ netOp := CT_NetOp_NewBlock;
+ end else begin
+ // Will send a FAST PROPAGATION BLOCK as described at PIP-0015
+ netOp := CT_NetOp_NewBlock_Fast_Propagation;
+ end;
NewBlock.SaveBlockToStream(netOp = CT_NetOp_NewBlock_Fast_Propagation,data); // Will save all only if not FAST PROPAGATION
// Send Aggregated Hashsrate based on network protocol available version
if FNetProtocolVersion.protocol_available>=CT_MIN_NetProtocol_Use_Aggregated_Hashrate then begin
@@ -4644,6 +4664,9 @@ function TNetConnection.Send_NewBlockFound(const NewBlock: TPCOperationsComp): B
data.Write(opRef,SizeOf(opRef));
end;
end;
+ TLog.NewLog(ltdebug,ClassName,Format('Sending NEW FAST PROPAGATION BLOCK %d with %d operations in %d bytes to %s',[NewBlock.OperationBlock.block,c,data.Size,ClientRemoteAddr]));
+ end else begin
+ TLog.NewLog(ltdebug,ClassName,Format('Sending NEW BLOCK %d with %d operations in %d bytes to %s',[NewBlock.OperationBlock.block,NewBlock.Count,data.Size,ClientRemoteAddr]));
end;
Send(ntp_autosend,netOp,0,request_id,data);
finally
@@ -5131,7 +5154,7 @@ procedure TNetworkAdjustedTime.AddNewIp(const clientIp: String; clientTimestamp
inc(P^.counter);
inc(FTotalCounter);
UpdateMedian(l);
- TLog.NewLog(ltDebug,ClassName,Format('AddNewIp (%s,%d) - Total:%d/%d Offset:%d',[clientIp,clientTimestamp,l.Count,FTotalCounter,FTimeOffset]));
+ {$IFDEF HIGHLOG}TLog.NewLog(ltDebug,ClassName,Format('AddNewIp (%s,%d) - Total:%d/%d Offset:%d',[clientIp,clientTimestamp,l.Count,FTotalCounter,FTimeOffset]));{$ENDIF}
finally
FTimesList.UnlockList;
end;
@@ -5206,9 +5229,9 @@ procedure TNetworkAdjustedTime.RemoveIp(const clientIp: String);
Dec(FTotalCounter);
end;
UpdateMedian(l);
- if (i>=0) then
- TLog.NewLog(ltDebug,ClassName,Format('RemoveIp (%s) - Total:%d/%d Offset:%d',[clientIp,l.Count,FTotalCounter,FTimeOffset]))
- else TLog.NewLog(ltError,ClassName,Format('RemoveIp not found (%s) - Total:%d/%d Offset:%d',[clientIp,l.Count,FTotalCounter,FTimeOffset]))
+ if (i>=0) then begin
+ {$IFDEF HIGHLOG}TLog.NewLog(ltDebug,ClassName,Format('RemoveIp (%s) - Total:%d/%d Offset:%d',[clientIp,l.Count,FTotalCounter,FTimeOffset])){$ENDIF}
+ end else TLog.NewLog(ltError,ClassName,Format('RemoveIp not found (%s) - Total:%d/%d Offset:%d',[clientIp,l.Count,FTotalCounter,FTimeOffset]))
finally
FTimesList.UnlockList;
end;
diff --git a/src/core/UNode.pas b/src/core/UNode.pas
index 9f7735ac4..fb248a9d5 100644
--- a/src/core/UNode.pas
+++ b/src/core/UNode.pas
@@ -35,8 +35,8 @@ interface
uses
Classes, SysUtils,
- {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF}, UPCDataTypes,
- UBlockChain, UNetProtocol, UAccounts, UCrypto, UThread, SyncObjs, ULog, UBaseTypes, UPCOrderedLists;
+ {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF}, UPCDataTypes, UEncoding,
+ UBlockChain, UNetProtocol, UAccounts, UCrypto, UEPasa, UThread, SyncObjs, ULog, UBaseTypes, UPCOrderedLists;
{$I ./../config.inc}
@@ -44,10 +44,20 @@ interface
{ TNode }
- TSearchOperationResult = (found, invalid_params, blockchain_block_not_found);
-
TNodeNotifyEvents = Class;
+ TNode = Class;
+
+ TSaveMempoolOperationsThread = Class(TPCThread)
+ private
+ FNode : TNode;
+ FPendingToSave : Boolean;
+ protected
+ procedure BCExecute; override;
+ public
+ procedure Touch;
+ End;
+
TNode = Class(TComponent)
private
FNodeLog : TLog;
@@ -61,9 +71,10 @@ interface
FBCBankNotify : TPCBankNotify;
FPeerCache : String;
FDisabledsNewBlocksCount : Integer;
- FSentOperations : TOrderedRawList;
FBroadcastData : Boolean;
FUpdateBlockchain: Boolean;
+ FMaxPayToKeyPurchasePrice: Int64;
+ FSaveMempoolOperationsThread : TSaveMempoolOperationsThread;
{$IFDEF BufferOfFutureOperations}
FBufferAuxWaitingOperations : TOperationsHashTree;
{$ENDIF}
@@ -100,12 +111,9 @@ interface
//
Procedure NotifyBlocksChanged;
//
- procedure GetStoredOperationsFromAccount(AOwnerThread : TPCThread; const OperationsResume: TList; account_number: Cardinal; MaxDepth, StartOperation, EndOperation : Integer; SearchBackwardsStartingAtBlock : Cardinal=0); overload;
- procedure GetStoredOperationsFromAccount(const OperationsResume: TOperationsResumeList; account_number: Cardinal; MaxDepth, StartOperation, EndOperation : Integer; SearchBackwardsStartingAtBlock : Cardinal=0); overload;
- Function FindOperation(Const OperationComp : TPCOperationsComp; Const OperationHash : TRawBytes; var block : Cardinal; var operation_block_index : Integer) : Boolean;
- Function FindOperationExt(Const OperationComp : TPCOperationsComp; Const OperationHash : TRawBytes; var block : Cardinal; var operation_block_index : Integer) : TSearchOperationResult;
- Function FindNOperation(block, account, n_operation : Cardinal; var OpResume : TOperationResume) : TSearchOperationResult;
- Function FindNOperations(account, start_block : Cardinal; allow_search_previous : Boolean; n_operation_low, n_operation_high : Cardinal; OpResumeList : TOperationsResumeList) : TSearchOperationResult;
+ Function FindOperation(Const AOperationHash : TRawBytes; var AOperationResume : TOperationResume) : TSearchOpHashResult;
+ Function FindNOperation(block, account, n_operation : Cardinal; var OpResume : TOperationResume) : TSearchOpHashResult;
+ Function FindNOperations(account, start_block : Cardinal; allow_search_previous : Boolean; n_operation_low, n_operation_high : Cardinal; OpResumeList : TOperationsResumeList) : TSearchOpHashResult;
//
Procedure InitSafeboxAndOperations(max_block_to_read : Cardinal = $FFFFFFFF; restoreProgressNotify : TProgressNotify = Nil);
Procedure AutoDiscoverNodes(Const ips : String);
@@ -119,11 +127,24 @@ interface
function TryLockNode(MaxWaitMilliseconds : Cardinal) : Boolean;
procedure UnlockNode;
//
+ function GetAccountsAvailableByPublicKey(const APubKeys : TList; out AOnSafebox, AOnMempool : Integer) : Integer; overload;
+ function GetAccountsAvailableByPublicKey(const APubKey : TAccountKey; out AOnSafebox, AOnMempool : Integer) : Integer; overload;
+ //
Property BroadcastData : Boolean read FBroadcastData write FBroadcastData;
Property UpdateBlockchain : Boolean read FUpdateBlockchain write FUpdateBlockchain;
procedure MarkVerifiedECDSASignaturesFromMemPool(newOperationsToValidate : TPCOperationsComp);
class function NodeVersion : String;
class function GetPascalCoinDataFolder : String;
+ class procedure SetPascalCoinDataFolder(const ANewDataFolder : String);
+ //
+ function TryFindAccountByKey(const APubKey : TAccountKey; out AAccountNumber : Cardinal) : Boolean;
+ function TryFindPublicSaleAccount(AMaximumPrice : Int64; APreventRaceCondition : Boolean; out AAccountNumber : Cardinal) : Boolean;
+ Function TryResolveEPASA(const AEPasa : TEPasa; out AResolvedAccount: Cardinal): Boolean; overload;
+ Function TryResolveEPASA(const AEPasa : TEPasa; out AResolvedAccount: Cardinal; out AErrorMessage: String): Boolean; overload;
+ Function TryResolveEPASA(const AEPasa : TEPasa; out AResolvedAccount: Cardinal; out AResolvedKey : TAccountKey; out ARequiresPurchase : boolean): Boolean; overload;
+ Function TryResolveEPASA(const AEPasa : TEPasa; out AResolvedAccount: Cardinal; out AResolvedKey : TAccountKey; out ARequiresPurchase : boolean; out AErrorMessage: String): Boolean; overload;
+
+ Property MaxPayToKeyPurchasePrice: Int64 read FMaxPayToKeyPurchasePrice write FMaxPayToKeyPurchasePrice;
End;
TThreadSafeNodeNotifyEvent = Class(TPCThread)
@@ -204,9 +225,11 @@ TNodeMessageManyEventHelper = record helper for TNodeMessageManyEvent
implementation
-Uses UOpTransaction, UConst, UTime, UCommon, UPCOperationsSignatureValidator, UFolderHelper;
+Uses UOpTransaction, UConst, UTime, UCommon, UPCOperationsSignatureValidator,
+ UFolderHelper, USettings;
var _Node : TNode;
+ _PascalCoinDataFolder : String;
{ TNode }
@@ -256,6 +279,11 @@ function TNode.AddNewBlockChain(SenderConnection: TNetConnection; NewBlockOperat
// Does not need to save a FOperations backup because is Sanitized by "TNode.OnBankNewBlock"
Result := Bank.AddNewBlockChainBlock(NewBlockOperations,TNetData.NetData.NetworkAdjustedTime.GetMaxAllowedTimestampForNewBlock,errors);
if Result then begin
+ {$IFDEF USE_ABSTRACTMEM}
+ If Not FBank.IsRestoringFromFile then begin
+ Bank.SafeBox.PCAbstractMem.FlushCache;
+ end;
+ {$ENDIF}
if Assigned(SenderConnection) then begin
FNodeLog.NotifyNewLog(ltupdate,SenderConnection.ClassName,Format(';%d;%s;%s;;%d;%d;%d;%s',[OpBlock.block,sClientRemoteAddr,OpBlock.block_payload.ToPrintable,
OpBlock.timestamp,UnivDateTimeToUnix(DateTime2UnivDateTime(Now)),UnivDateTimeToUnix(DateTime2UnivDateTime(Now)) - OpBlock.timestamp,IntToHex(OpBlock.compact_target,8)]));
@@ -275,7 +303,7 @@ function TNode.AddNewBlockChain(SenderConnection: TNetConnection; NewBlockOperat
if Result then begin
opsht := TOperationsHashTree.Create;
Try
- j := Random(3); // j=0,1 or 2
+ j := Random(5);
If (Bank.LastBlockFound.OperationBlock.block>j) then
minBlockResend:=Bank.LastBlockFound.OperationBlock.block - j
else minBlockResend:=1;
@@ -286,20 +314,18 @@ function TNode.AddNewBlockChain(SenderConnection: TNetConnection; NewBlockOperat
While (opsht.OperationsCount'+inttostr(minBlockResend)+') ('+inttostr(i+1)+'/'+inttostr(FOperations.Count)+'): '+FOperations.Operation[i].ToString);{$ENDIF}
+ resendOp.ResendOnBlock := LLockedMempool.OperationBlock.block;
+ resendOp.ResendCount := resendOp.ResendCount + 1;
end;
inc(i);
end;
- If LLockedMempool.Count>0 then begin
- TLog.NewLog(ltinfo,classname,Format('Resending %d operations for new block (Buffer Pending Operations:%d)',[opsht.OperationsCount,LLockedMempool.Count]));
+ If opsht.OperationsCount>0 then begin
+ TLog.NewLog(ltinfo,classname,Format('Resending %d operations for new block (Mempool Pending Operations:%d)',[opsht.OperationsCount,LLockedMempool.Count]));
{$IFDEF HIGHLOG}
if opsht.OperationsCount>0 then begin
for i := 0 to opsht.OperationsCount - 1 do begin
@@ -311,15 +337,6 @@ function TNode.AddNewBlockChain(SenderConnection: TNetConnection; NewBlockOperat
Finally
UnlockMempoolRead;
End;
- // Clean sent operations buffer
- j := 0;
- for i := FSentOperations.Count-1 downto 0 do begin
- If (FSentOperations.GetTag(i)0 then begin
- LLockedMempool := LockMempoolRead;
- try
- // Save operations buffer
- Bank.Storage.SavePendingBufferOperations(LLockedMempool.OperationsHashTree);
- finally
- UnlockMempoolRead;
- end;
+ FSaveMempoolOperationsThread.Touch; // This will indicate to thread that mempool needs to be saved
LTickCount := TPlatform.GetElapsedMilliseconds(LTickCount);
if LTickCount=0 then LTickCount:=1;
if Assigned(SenderConnection) then begin
s := SenderConnection.ClientRemoteAddr;
end else s := '(SELF)';
- TLog.NewLog(ltdebug,Classname,Format('Finalizing AddOperations from %s Operations:%d of %d valids:%d spam:%d invalids:%d repeated:%d Miliseconds:%d %.1f ops/sec',
- [s,LOpsToAdd.Count,AOperationsHashTreeToAdd.OperationsCount,Result,nSpam,nError,nRepeated,LTickCount,LOpsToAdd.Count * 1000 / LTickCount]));
+ {$IFDEF HIGHLOG}TLog.NewLog(ltdebug,Classname,Format('Finalizing AddOperations from %s Operations:%d of %d valids:%d spam:%d invalids:%d repeated:%d Miliseconds:%d %.1f ops/sec',
+ [s,LOpsToAdd.Count,AOperationsHashTreeToAdd.OperationsCount,Result,nSpam,nError,nRepeated,LTickCount,LOpsToAdd.Count * 1000 / LTickCount]));{$ENDIF}
if FBroadcastData then begin
// Send to other nodes
j := TNetData.NetData.ConnectionsCountAll;
@@ -625,7 +636,7 @@ procedure TNode.AutoDiscoverNodes(const ips: String);
constructor TNode.Create(AOwner: TComponent);
begin
- FSentOperations := TOrderedRawList.Create;
+ FMaxPayToKeyPurchasePrice := 0;
FNodeLog := TLog.Create(Self);
FNodeLog.ProcessGlobalLogs := false;
RegisterOperationsClass;
@@ -649,11 +660,14 @@ constructor TNode.Create(AOwner: TComponent);
{$ENDIF}
FBroadcastData := True;
FUpdateBlockchain := True;
+ FSaveMempoolOperationsThread := TSaveMempoolOperationsThread.Create(True);
+ FSaveMempoolOperationsThread.FNode := Self;
+ FSaveMempoolOperationsThread.Resume;
if Not Assigned(_Node) then _Node := Self;
end;
-class procedure TNode.DecodeIpStringToNodeServerAddressArray(
- const Ips: String; Var NodeServerAddressArray: TNodeServerAddressArray);
+class procedure TNode.DecodeIpStringToNodeServerAddressArray(const Ips: String;
+ var NodeServerAddressArray: TNodeServerAddressArray);
Function GetIp(var ips_string : String; var nsa : TNodeServerAddress) : Boolean;
Const CT_IP_CHARS = ['a'..'z','A'..'Z','0'..'9','.','-','_'];
var i : Integer;
@@ -667,18 +681,18 @@ class procedure TNode.DecodeIpStringToNodeServerAddressArray(
end;
// Delete invalid chars:
i := 0;
- while (i<=High(ips_string)) AND (NOT (ips_string.Chars[i] IN CT_IP_CHARS)) do inc(i);
- if (i>Low(ips_string)) then ips_string := ips_string.Substring(i,Length(ips_string));
+ while (i<=(ips_string.Length-1)) AND (NOT (ips_string.Chars[i] IN CT_IP_CHARS)) do inc(i);
+ if (i>0) then ips_string := ips_string.Substring(i,ips_string.Length);
// Capture IP value
i := 0;
- while (i<=High(ips_string)) and (ips_string.Chars[i] in CT_IP_CHARS) do inc(i);
+ while (i<=(ips_string.Length-1)) and (ips_string.Chars[i] in CT_IP_CHARS) do inc(i);
if (i>0) then begin
nsa.ip := ips_string.Substring(0,i);
// Capture possible :Port value
- if (i<=High(ips_string)) and (ips_string.Chars[i]=':') then begin
+ if (i<=(ips_string.Length-1)) and (ips_string.Chars[i]=':') then begin
inc(i);
port := '';
- while (i<=High(ips_string)) and (ips_string.Chars[i] in ['0'..'9']) do begin
+ while (i<=(ips_string.Length-1)) and (ips_string.Chars[i] in ['0'..'9']) do begin
port := port + ips_string.Chars[i];
inc(i);
end;
@@ -708,6 +722,11 @@ destructor TNode.Destroy;
begin
TLog.NewLog(ltInfo,ClassName,'TNode.Destroy START');
Try
+ step := 'Deleting SaveMempoolOperationsThread';
+ FSaveMempoolOperationsThread.Terminate;
+ FSaveMempoolOperationsThread.WaitFor;
+ FreeAndNil(FSaveMempoolOperationsThread);
+
step := 'Deleting critical section';
FreeAndNil(FLockMempool);
FreeAndNil(FOperationSequenceLock);
@@ -725,8 +744,6 @@ destructor TNode.Destroy;
FreeAndNil(FMemPoolAddingOperationsList);
step := 'Assigning NIL to node var';
if _Node=Self then _Node := Nil;
- Step := 'Destroying SentOperations list';
- FreeAndNil(FSentOperations);
step := 'Destroying Bank';
FreeAndNil(FBCBankNotify);
@@ -757,6 +774,170 @@ procedure TNode.EnableNewBlocks;
dec(FDisabledsNewBlocksCount);
end;
+function TNode.TryFindAccountByKey(const APubKey: TAccountKey;
+ out AAccountNumber: Cardinal): Boolean;
+ // Finds the smallest numbered account with selected key (or returns false)
+var Lpka : TSafeboxPubKeysAndAccounts;
+ LAccountsNumberList : TAccountsNumbersList;
+begin
+ Result := False;
+ Lpka := Bank.SafeBox.OrderedAccountKeysList;
+ if Assigned(Lpka) then begin
+ LAccountsNumberList := Lpka.GetAccountsUsingThisKey(APubKey);
+ if Assigned(LAccountsNumberList) then begin
+ if LAccountsNumberList.Count>0 then begin
+ AAccountNumber := LAccountsNumberList.Get(0);
+ Result := True;
+ end;
+ end;
+ end;
+end;
+
+function TNode.TryFindPublicSaleAccount(AMaximumPrice: Int64; APreventRaceCondition : Boolean;
+ out AAccountNumber: Cardinal): Boolean;
+ // Finds an account at or below argument purchase price (or returns false)
+ // APreventRaceCondition: When True will return a random account in valid range price
+ // Limitations: Account must be >0
+var LtempAccNumber : Int64;
+ LLastValidAccount, LCurrAccount : TAccount;
+ LContinueSearching : Boolean;
+begin
+ Result := False;
+
+ // Sorted list: Bank.SafeBox.AccountsOrderedBySalePrice
+ // Note: List is sorted by Sale price (ASCENDING), but NOT by public/private sale, must check
+
+ if Not Bank.SafeBox.AccountsOrderedBySalePrice.FindLowest(LtempAccNumber) then Exit(False);
+ LCurrAccount := GetMempoolAccount(LtempAccNumber);
+
+ if (LCurrAccount.accountInfo.price<=AMaximumPrice)
+ and (TAccountComp.IsAccountForPublicSale(LCurrAccount.accountInfo)) then begin
+ LLastValidAccount := LCurrAccount;
+ LContinueSearching := (APreventRaceCondition) And (Random(50)=0);
+ end else begin
+ LLastValidAccount := CT_Account_NUL;
+ LContinueSearching := True;
+ end;
+
+ while (LCurrAccount.accountInfo.price<=AMaximumPrice) and (LContinueSearching) do begin
+
+ if TAccountComp.IsAccountForPublicSale(LCurrAccount.accountInfo) then LLastValidAccount := LCurrAccount;
+
+ if Not (Bank.SafeBox.AccountsOrderedBySalePrice.FindSuccessor(LtempAccNumber,LtempAccNumber)) then Break;
+ LCurrAccount := GetMempoolAccount(LtempAccNumber);
+
+ // If price increased, then do not continue and use LastValidAccount
+ if (LLastValidAccount.account>0)
+ and (LLastValidAccount.accountInfo.price <> LCurrAccount.accountInfo.price) then Break;
+
+ // Continue?
+ LContinueSearching :=
+ (LLastValidAccount.account=0) // This means that no valid account has been found yet...
+ or
+ (LContinueSearching And (Random(50)=0)); // Random prevention
+ end;
+ if (LLastValidAccount.account>0) then begin
+ AAccountNumber := LLastValidAccount.account;
+ Result := True;
+ end else begin
+ AAccountNumber := 0;
+ Result := False;
+ end;
+end;
+
+Function TNode.TryResolveEPASA(const AEPasa : TEPasa; out AResolvedAccount: Cardinal): Boolean;
+var LErrMsg : String;
+begin
+ Result := TryResolveEPASA(AEPasa, AResolvedAccount, LErrMsg);
+end;
+
+Function TNode.TryResolveEPASA(const AEPasa : TEPasa; out AResolvedAccount: Cardinal; out AErrorMessage: String): Boolean;
+var
+ LAccountKey : TAccountKey;
+ LRequiresPurchase : Boolean;
+begin
+ Result := TryResolveEPASA(AEPasa, AResolvedAccount, LAccountKey, LRequiresPurchase, AErrorMessage);
+ if Result AND AEPasa.IsPayToKey then begin
+ Result := False;
+ AErrorMessage := 'EPASA was a pay-to-key style';
+ end;
+end;
+
+Function TNode.TryResolveEPASA(const AEPasa : TEPasa; out AResolvedAccount: Cardinal; out AResolvedKey : TAccountKey; out ARequiresPurchase : boolean): Boolean;
+var LErrMsg : String;
+begin
+ Result := TryResolveEPASA(AEPasa, AResolvedAccount, AResolvedKey, ARequiresPurchase, LErrMsg);
+end;
+
+Function TNode.TryResolveEPASA(const AEPasa : TEPasa; out AResolvedAccount: Cardinal; out AResolvedKey : TAccountKey; out ARequiresPurchase : boolean; out AErrorMessage: String): Boolean;
+var
+ LErrMsg : String;
+begin
+ AResolvedAccount := 0;
+ AResolvedKey.Clear;
+ ARequiresPurchase := False;
+ AErrorMessage := '';
+ if (AEPasa.IsPayToKey) then begin
+ // Parse account key in EPASA
+ if NOT TAccountComp.AccountPublicKeyImport(AEPasa.Payload, AResolvedKey, LErrMsg) then begin
+ AResolvedAccount := CT_AccountNo_NUL;
+ AResolvedKey := CT_Account_NUL.accountInfo.accountKey;
+ ARequiresPurchase := False;
+ AErrorMessage := Format('Invalid key specified in PayToKey EPASA "%s". %s',[AEPasa.ToString(), LErrMsg]);
+ Exit(False);
+ end;
+
+ // Try to find key in safebox
+ if TryFindAccountByKey(AResolvedKey, AResolvedAccount) then begin
+ // Key already exists in SafeBox, so send to that account
+ ARequiresPurchase := False;
+ Exit(True);
+ end;
+
+ // If no key found, find optimal public purchase account
+ if TryFindPublicSaleAccount(MaxPayToKeyPurchasePrice, True, AResolvedAccount) then begin
+ // Account needs to be purchased
+ ARequiresPurchase := True;
+ Exit(True);
+ end;
+
+ // Account could not be resolved
+ AResolvedAccount := CT_AccountNo_NUL;
+ AResolvedKey := CT_Account_NUL.accountInfo.accountKey;
+ ARequiresPurchase := False;
+ AErrorMessage := 'No account could be resolved for pay to key EPASA';
+ Exit(False);
+
+ end else if (AEPasa.IsAddressedByName) then begin
+ // Find account by name
+ AResolvedAccount := Bank.SafeBox.FindAccountByName(AEPasa.AccountName);
+ AResolvedKey := CT_Account_NUL.accountInfo.accountKey;
+ ARequiresPurchase := False;
+ if AResolvedAccount = CT_AccountNo_NUL then begin
+ // No account with name found
+ AResolvedAccount := CT_AccountNo_NUL;
+ AResolvedKey := CT_Account_NUL.accountInfo.accountKey;
+ ARequiresPurchase := False;
+ AErrorMessage := Format('No account with name "%s" was found', [AEPasa.AccountName]);
+ Exit(False);
+ end;
+ Exit(True);
+ end;
+ // addressed by number
+ if NOT AEPasa.IsAddressedByNumber then raise Exception.Create('Internal Error c8ecd69d-3621-4f5e-b4f1-9926ab2f5013');
+ if NOT AEPasa.Account.HasValue then raise Exception.Create('Internal Error 544c8cb9-b700-4b5f-93ca-4d045d0a06ae');
+ AResolvedAccount := AEPasa.Account.Value;
+ if (AResolvedAccount < 0) or (AResolvedAccount >= Self.Bank.AccountsCount) then begin
+ AResolvedAccount := CT_AccountNo_NUL;
+ AResolvedKey := CT_Account_NUL.accountInfo.accountKey;
+ ARequiresPurchase := False;
+ AErrorMessage := Format('Account number %d does not exist in safebox',[AEPasa.Account.Value]);
+ Exit(False);
+ end;
+ Result := true;
+end;
+
+
function TNode.TryLockNode(MaxWaitMilliseconds: Cardinal): Boolean;
begin
Result := TPCThread.TryProtectEnterCriticalSection(Self,MaxWaitMilliseconds,FLockMempool);
@@ -829,7 +1010,7 @@ function TNode.IsBlockChainValid(var WhyNot : String): Boolean;
Result := true;
end;
-function TNode.IsReady(Var CurrentProcess: String): Boolean;
+function TNode.IsReady(var CurrentProcess: String): Boolean;
var LLockedMempool : TPCOperationsComp;
begin
Result := false;
@@ -894,148 +1075,8 @@ procedure TNode.NotifyBlocksChanged;
end;
end;
-procedure TNode.GetStoredOperationsFromAccount(AOwnerThread : TPCThread; const OperationsResume: TList; account_number: Cardinal;
- MaxDepth, StartOperation, EndOperation: Integer; SearchBackwardsStartingAtBlock: Cardinal);
- // Optimization:
- // For better performance, will only include at "OperationsResume" values betweeen "startOperation" and "endOperation"
-
- // New use case: Will allow to start in an unknown block when first_block_is_unknows
- Procedure DoGetFromBlock(block_number : Integer; last_balance : Int64; act_depth : Integer; nOpsCounter : Integer; first_block_is_unknown : Boolean);
- var opc : TPCOperationsComp;
- op : TPCOperation;
- OPR : TOperationResume;
- l : TList;
- i : Integer;
- last_block_number : Integer;
- found_in_block : Boolean;
- acc_0_miner_reward, acc_4_dev_reward : Int64;
- acc_4_for_dev : Boolean;
- begin
- if Assigned(AOwnerThread) then begin
- if AOwnerThread.terminated then Exit;
- end;
- if (act_depth<=0) then exit;
- opc := TPCOperationsComp.Create(Nil);
- Try
- l := TList.Create;
- try
- last_block_number := block_number+1;
- while (last_block_number>block_number) And (act_depth>0)
- And (block_number >= (account_number DIV CT_AccountsPerBlock))
- And (nOpsCounter <= EndOperation) do begin
- if Assigned(AOwnerThread) then begin
- if AOwnerThread.terminated then Exit;
- end;
- found_in_block := False;
- last_block_number := block_number;
- l.Clear;
- If not Bank.Storage.LoadBlockChainBlock(opc,block_number) then begin
- TLog.NewLog(ltdebug,ClassName,'Block '+inttostr(block_number)+' not found. Cannot read operations');
- exit;
- end;
- opc.OperationsHashTree.GetOperationsAffectingAccount(account_number,l);
- for i := l.Count - 1 downto 0 do begin
- op := opc.Operation[PtrInt(l.Items[i])];
- If TPCOperation.OperationToOperationResume(block_number,Op,False,account_number,OPR) then begin
- OPR.NOpInsideBlock := PtrInt(l.Items[i]);
- OPR.time := opc.OperationBlock.timestamp;
- OPR.Block := block_number;
- If last_balance>=0 then begin
- OPR.Balance := last_balance;
- last_balance := last_balance - ( OPR.Amount + OPR.Fee );
- end else OPR.Balance := -1; // Undetermined
- if (nOpsCounter>=StartOperation) And (nOpsCounter<=EndOperation) then begin
- OperationsResume.Add(OPR);
- end;
- inc(nOpsCounter);
- found_in_block := True;
- end;
- end;
-
- // Is a new block operation?
- if (TAccountComp.AccountBlock(account_number)=block_number) then begin
- TPascalCoinProtocol.GetRewardDistributionForNewBlock(opc.OperationBlock,acc_0_miner_reward,acc_4_dev_reward,acc_4_for_dev);
- If ((account_number MOD CT_AccountsPerBlock)=0) Or
- ( ((account_number MOD CT_AccountsPerBlock)=CT_AccountsPerBlock-1) AND (acc_4_for_dev) ) then begin
- OPR := CT_TOperationResume_NUL;
- OPR.OpType:=CT_PseudoOp_Reward;
- OPR.valid := true;
- OPR.Block := block_number;
- OPR.time := opc.OperationBlock.timestamp;
- OPR.AffectedAccount := account_number;
- If ((account_number MOD CT_AccountsPerBlock)=0) then begin
- OPR.Amount := acc_0_miner_reward;
- OPR.OperationTxt := 'Miner reward';
- OPR.OpSubtype:=CT_PseudoOpSubtype_Miner;
- end else begin
- OPR.Amount := acc_4_dev_reward;
- OPR.OperationTxt := 'Dev reward';
- OPR.OpSubtype:=CT_PseudoOpSubtype_Developer;
- end;
- If last_balance>=0 then begin
- OPR.Balance := last_balance;
- end else OPR.Balance := -1; // Undetermined
- if (nOpsCounter>=StartOperation) And (nOpsCounter<=EndOperation) then begin
- OperationsResume.Add(OPR);
- end;
- inc(nOpsCounter);
- found_in_block := True;
- end;
- end;
- //
- dec(act_depth);
- If (Not found_in_block) And (first_block_is_unknown) then begin
- Dec(block_number);
- end else begin
- block_number := opc.PreviousUpdatedBlocks.GetPreviousUpdatedBlock(account_number,block_number);
- end;
- opc.Clear(true);
- end;
- finally
- l.Free;
- end;
- Finally
- opc.Free;
- End;
- end;
-
-Var acc : TAccount;
- startBlock : Cardinal;
- lastBalance : Int64;
-begin
- if MaxDepth<0 then Exit;
- if account_number>=Bank.SafeBox.AccountsCount then Exit;
- if StartOperation>EndOperation then Exit;
- acc := Bank.SafeBox.Account(account_number);
- if (acc.GetLastUpdatedBlock>0) Or (acc.account=0) then Begin
- if (SearchBackwardsStartingAtBlock=0) Or (SearchBackwardsStartingAtBlock>=acc.GetLastUpdatedBlock) then begin
- startBlock := acc.GetLastUpdatedBlock;
- lastBalance := acc.balance;
- end else begin
- startBlock := SearchBackwardsStartingAtBlock;
- lastBalance := -1;
- end;
- DoGetFromBlock(startBlock,lastBalance,MaxDepth,0,startBlock<>acc.GetLastUpdatedBlock);
- end;
-end;
-
-procedure TNode.GetStoredOperationsFromAccount(const OperationsResume: TOperationsResumeList; account_number: Cardinal; MaxDepth, StartOperation, EndOperation: Integer; SearchBackwardsStartingAtBlock : Cardinal = 0);
-var LOpList : TList;
- i : Integer;
-begin
- LOpList := TList.Create;
- try
- GetStoredOperationsFromAccount(Nil,LOpList,account_number,MaxDepth,StartOperation,EndOperation,SearchBackwardsStartingAtBlock);
- for i := 0 to LOpList.Count-1 do begin
- OperationsResume.Add(LOpList[i]);
- end;
- finally
- LOpList.Free;
- end;
-end;
-
function TNode.FindNOperation(block, account, n_operation: Cardinal;
- var OpResume: TOperationResume): TSearchOperationResult;
+ var OpResume: TOperationResume): TSearchOpHashResult;
// Note: block = 0 search in all blocks. If Block>0 must match a valid block with operation with this account
var oprl : TOperationsResumeList;
begin
@@ -1043,14 +1084,14 @@ function TNode.FindNOperation(block, account, n_operation: Cardinal;
try
Result := FindNOperations(account,block,block=0,n_operation,n_operation,oprl);
If oprl.Count>0 then begin
- OpResume := oprl.OperationResume[0];
+ OpResume := oprl.Items[0];
end else OpResume := CT_TOperationResume_NUL;
finally
oprl.Free;
end;
end;
-function TNode.FindNOperations(account, start_block : Cardinal; allow_search_previous : Boolean; n_operation_low, n_operation_high: Cardinal; OpResumeList: TOperationsResumeList): TSearchOperationResult;
+function TNode.FindNOperations(account, start_block : Cardinal; allow_search_previous : Boolean; n_operation_low, n_operation_high: Cardinal; OpResumeList: TOperationsResumeList): TSearchOpHashResult;
var i : Integer;
op : TPCOperation;
aux_block, block : Cardinal;
@@ -1060,7 +1101,7 @@ function TNode.FindNOperations(account, start_block : Cardinal; allow_search_pre
LLockedMempool : TPCOperationsComp;
begin
OpResumeList.Clear;
- Result := invalid_params;
+ Result := OpHash_invalid_params;
block := start_block;
If (block>=Bank.BlocksCount) then exit; // Invalid block number
If (account>=Bank.AccountsCount) then exit; // Invalid account number
@@ -1088,7 +1129,7 @@ function TNode.FindNOperations(account, start_block : Cardinal; allow_search_pre
OpResumeList.Add(opr);
if (n_operation>n_operation_low) then dec(n_operation)
else begin
- Result := found;
+ Result := OpHash_found;
Exit;
end;
end;
@@ -1105,7 +1146,7 @@ function TNode.FindNOperations(account, start_block : Cardinal; allow_search_pre
While (n_operation>0) And (n_operation>=n_operation_low) And (block>0) do begin
aux_block := block;
If Not Bank.LoadOperations(OperationComp,block) then begin
- Result := blockchain_block_not_found; // Cannot continue searching!
+ Result := OpHash_block_not_found; // Cannot continue searching!
exit;
end;
For i:=OperationComp.Count-1 downto 0 do begin
@@ -1121,12 +1162,12 @@ function TNode.FindNOperations(account, start_block : Cardinal; allow_search_pre
OpResumeList.Add(opr);
if (n_operation>n_operation_low) then dec(n_operation)
else begin
- Result := found;
+ Result := OpHash_found;
Exit;
end;
end else begin
If (op.GetAccountN_Operation(account) < n_operation) then begin
- If (n_operation_high>n_operation_low) then Result := found; // multiple search, result is found (not an error)
+ If (n_operation_high>n_operation_low) then Result := OpHash_found; // multiple search, result is found (not an error)
Exit // First occurrence is lower
end;
end;
@@ -1142,7 +1183,7 @@ function TNode.FindNOperations(account, start_block : Cardinal; allow_search_pre
finally
OperationComp.Free;
end;
- Result := found;
+ Result := OpHash_found;
end;
procedure TNode.InitSafeboxAndOperations(max_block_to_read : Cardinal = $FFFFFFFF; restoreProgressNotify : TProgressNotify = Nil);
@@ -1164,40 +1205,36 @@ procedure TNode.InitSafeboxAndOperations(max_block_to_read : Cardinal = $FFFFFFF
end;
end;
-function TNode.FindOperationExt(const OperationComp: TPCOperationsComp;
- const OperationHash: TRawBytes; var block: Cardinal;
- var operation_block_index: Integer): TSearchOperationResult;
+function TNode.FindOperation(Const AOperationHash : TRawBytes; var AOperationResume : TOperationResume) : TSearchOpHashResult;
{ With a OperationHash, search it }
-var account,n_operation : Cardinal;
+var
i : Integer;
op : TPCOperation;
- initial_block, aux_block, aux_n_op : Cardinal;
- opHashValid, opHash_OLD : TRawBytes;
+ opHashValid : TRawBytes;
md160 : TRawBytes;
LLockedMempool : TPCOperationsComp;
+ LBlock, LAccount, LN_Operation : Cardinal;
begin
- Result := invalid_params;
+ Result := OpHash_invalid_params;
// Decode OperationHash
- If not TPCOperation.DecodeOperationHash(OperationHash,block,account,n_operation,md160) then exit;
- initial_block := block;
+ If not TPCOperation.DecodeOperationHash(AOperationHash,LBlock,LAccount,LN_Operation,md160) then exit;
//
- If (account>=Bank.AccountsCount) then exit; // Invalid account number
+ If (LAccount>=Bank.AccountsCount) then exit; // Invalid account number
// If block=0 then we must search in pending operations first
- if (block=0) then begin
+ if (LBlock=0) then begin
LLockedMempool := LockMempoolRead;
Try
LLockedMempool.Lock;
Try
For i:=0 to LLockedMempool.Count-1 do begin
op := LLockedMempool.Operation[i];
- If (op.SignerAccount=account) then begin
+ If (op.SignerAccount=LAccount) then begin
opHashValid := TPCOperation.OperationHashValid(op,0);
- opHash_OLD := TPCOperation.OperationHash_OLD(op,0);
- If TBaseType.Equals(opHashValid,OperationHash) or
- ((FBank.BlocksCount=Bank.BlocksCount) then exit;
- // Search in previous blocks
- While (block>0) do begin
- aux_block := block;
- If Not Bank.LoadOperations(OperationComp,block) then begin
- Result := blockchain_block_not_found;
- exit;
- end;
- For i:=OperationComp.Count-1 downto 0 do begin
- op := OperationComp.Operation[i];
- if (op.IsSignerAccount(account)) then begin
- aux_n_op := op.GetAccountN_Operation(account);
- If (aux_n_op=aux_block) then exit; // Error... not found a valid block positioning
- if (initial_block<>0) then exit; // If not found in specified block, no valid hash
end;
-end;
-
-function TNode.FindOperation(const OperationComp: TPCOperationsComp;
- const OperationHash: TRawBytes; var block: Cardinal;
- var operation_block_index: Integer): Boolean;
- { With a OperationHash, search it }
-var sor : TSearchOperationResult;
-begin
- sor := FindOperationExt(OperationComp,OperationHash,block,operation_block_index);
- Result := sor = found;
+ Result := Bank.Storage.FindOperation(AOperationHash,AOperationResume);
end;
procedure TNode.NotifyNetClientMessage(Sender: TNetConnection; const TheMessage: String);
@@ -1280,6 +1270,63 @@ function TNode.MempoolOperationsCount: Integer;
end;
end;
+function TNode.GetAccountsAvailableByPublicKey(const APubKey: TAccountKey;
+ out AOnSafebox, AOnMempool: Integer): Integer;
+var LPubKeys: TList;
+begin
+ LPubKeys := TList.Create;
+ Try
+ LPubKeys.Add(APubKey);
+ Result := GetAccountsAvailableByPublicKey(LPubKeys,AOnSafebox,AOnMempool);
+ Finally
+ LPubKeys.Free;
+ End;
+end;
+
+function TNode.GetAccountsAvailableByPublicKey(
+ const APubKeys: TList; out AOnSafebox,
+ AOnMempool: Integer): Integer;
+var Lmempool : TPCOperationsComp;
+ i,j,k : Integer;
+ Lop : TPCOperation;
+ LopResume : TOperationResume;
+ Lpubkeys : TSafeboxPubKeysAndAccounts;
+ Laccounts : TAccountsNumbersList;
+begin
+ AOnMempool := 0;
+ AOnSafebox := 0;
+ // Check safebox
+ Lpubkeys := Bank.SafeBox.OrderedAccountKeysList;
+ if Assigned(Lpubkeys) then begin
+ for i := 0 to APubKeys.Count-1 do begin
+ Laccounts := Lpubkeys.GetAccountsUsingThisKey(APubKeys[i]);
+ if Assigned(Laccounts) then begin
+ Inc(AOnSafebox,Laccounts.Count);
+ end;
+ end;
+ end else AOnSafebox := -1;
+ for i := 0 to APubKeys.Count-1 do begin
+ // Check mempool
+ Lmempool := LockMempoolRead;
+ try
+ for j := 0 to Lmempool.Count-1 do begin
+ Lop := Lmempool.Operation[j];
+ Lop.OperationToOperationResume(Bank.BlocksCount,Lop,True,Lop.SignerAccount,LopResume);
+ for k:=0 to Length(LopResume.Changers)-1 do begin
+ if (public_key in LopResume.Changers[k].Changes_type) and (LopResume.Changers[k].New_Accountkey.IsEqualTo(APubKeys[i])) then begin
+ // New account is on the mempool!
+ inc(AOnMempool);
+ end;
+ end;
+ end;
+ finally
+ UnlockMempoolRead;
+ end;
+ end;
+ if AOnSafebox>=0 then Result := (AOnMempool + AOnsafebox)
+ else Result := AOnMempool;
+end;
+
function TNode.GetMempoolAccount(AAccountNumber : Cardinal): TAccount;
var LLockedMempool : TPCOperationsComp;
begin
@@ -1293,7 +1340,16 @@ function TNode.GetMempoolAccount(AAccountNumber : Cardinal): TAccount;
class function TNode.GetPascalCoinDataFolder: String;
begin
- Result := TFolderHelper.GetDataFolder(CT_PascalCoin_Data_Folder);
+ if (_PascalCoinDataFolder.Trim.Length>0) then begin
+ Result := _PascalCoinDataFolder;
+ end else begin
+ Result := TFolderHelper.GetDataFolder(CT_PascalCoin_Data_Folder);
+ end;
+end;
+
+class procedure TNode.SetPascalCoinDataFolder(const ANewDataFolder: String);
+begin
+ _PascalCoinDataFolder := ANewDataFolder;
end;
function TNode.LockMempoolRead: TPCOperationsComp;
@@ -1598,8 +1654,40 @@ destructor TThreadNodeNotifyOperations.Destroy;
inherited;
end;
+{ TSaveMempoolOperationsThread }
+
+procedure TSaveMempoolOperationsThread.BCExecute;
+var i : Integer;
+ LLocked : TPCOperationsComp;
+begin
+ FPendingToSave := false;
+ repeat
+ if FPendingToSave then begin
+ LLocked := FNode.LockMempoolRead;
+ try
+ FPendingToSave := False;
+ FNode.Bank.Storage.SavePendingBufferOperations(LLocked.OperationsHashTree);
+ finally
+ FNode.UnlockMempoolRead;
+ end;
+ end;
+ // Wait 10 seconds prior to save updates on mempool
+ i := 0;
+ while (i<1000) and (Not Terminated) do begin
+ Sleep(10);
+ inc(i);
+ end;
+ until (false) or (Terminated);
+end;
+
+procedure TSaveMempoolOperationsThread.Touch;
+begin
+ FPendingToSave := True;
+end;
+
initialization
_Node := Nil;
+ _PascalCoinDataFolder := '';
finalization
FreeAndNil(_Node);
end.
diff --git a/src/core/UOpTransaction.pas b/src/core/UOpTransaction.pas
index 826cc882b..ae00de962 100644
--- a/src/core/UOpTransaction.pas
+++ b/src/core/UOpTransaction.pas
@@ -27,12 +27,12 @@ interface
Uses UCrypto, UBlockChain, Classes, UAccounts, UBaseTypes,
{$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF},
- UPCDataTypes;
+ UPCDataTypes, UEPasa, UOrderedList;
Type
// Operations Type
TOpTransactionStyle = (transaction, transaction_with_auto_buy_account, buy_account, transaction_with_auto_atomic_swap);
- // transaction = Sinlge standard transaction
+ // transaction = Single standard transaction
// transaction_with_auto_buy_account = Single transaction made over an account listed for private sale. For STORING purposes only
// buy_account = A Buy account operation
// transaction_with_auto_atomic_swap = Single transaction made over an account listed for atomic swap (coin swap or account swap)
@@ -91,7 +91,7 @@ interface
public
function GetBufferForOpHash(UseProtocolV2 : Boolean): TRawBytes; override;
function DoOperation(APrevious : TAccountPreviousBlockInfo; ASafeBoxTransaction : TPCSafeBoxTransaction; var AErrors : String) : Boolean; override;
- procedure AffectedAccounts(list : TList); override;
+ procedure AffectedAccounts(list : TOrderedList); override;
//
class function OpType : Byte; override;
function OperationAmount : Int64; override;
@@ -132,7 +132,7 @@ interface
function SignerAccount : Cardinal; override;
function DestinationAccount : Int64; override;
function N_Operation : Cardinal; override;
- procedure AffectedAccounts(list : TList); override;
+ procedure AffectedAccounts(list : TOrderedList); override;
function OperationAmountByAccount(account : Cardinal) : Int64; override;
Constructor Create(ACurrentProtocol : Word; account_signer, n_operation, account_target: Cardinal; key:TECPrivateKey; new_account_key : TAccountKey; fee: UInt64; const payload: TOperationPayload);
Property Data : TOpChangeKeyData read FData;
@@ -171,7 +171,7 @@ interface
function SignerAccount : Cardinal; override;
function N_Operation : Cardinal; override;
function OperationAmountByAccount(account : Cardinal) : Int64; override;
- procedure AffectedAccounts(list : TList); override;
+ procedure AffectedAccounts(list : TOrderedList); override;
Constructor Create(ACurrentProtocol : word; account_number, n_operation: Cardinal; fee: UInt64; new_accountkey : TAccountKey);
Property Data : TOpRecoverFoundsData read FData;
Function toString : String; Override;
@@ -243,7 +243,7 @@ interface
function DestinationAccount : Int64; override;
function SellerAccount : Int64; override;
function N_Operation : Cardinal; override;
- procedure AffectedAccounts(list : TList); override;
+ procedure AffectedAccounts(list : TOrderedList); override;
function OperationAmountByAccount(account : Cardinal) : Int64; override;
Property Data : TOpListAccountData read FData;
Function toString : String; Override;
@@ -297,7 +297,7 @@ interface
function SignerAccount : Cardinal; override;
function DestinationAccount : Int64; override;
function N_Operation : Cardinal; override;
- procedure AffectedAccounts(list : TList); override;
+ procedure AffectedAccounts(list : TOrderedList); override;
function OperationAmountByAccount(account : Cardinal) : Int64; override;
Constructor CreateChangeAccountInfo(ACurrentProtocol : word;
account_signer, n_operation, account_target: Cardinal; key:TECPrivateKey;
@@ -349,7 +349,7 @@ interface
function SignerAccount : Cardinal; override;
function DestinationAccount : Int64; override;
function N_Operation : Cardinal; override;
- procedure AffectedAccounts(list : TList); override;
+ procedure AffectedAccounts(list : TOrderedList); override;
function OperationAmountByAccount(account : Cardinal) : Int64; override;
Constructor CreateOpData( ACurrentProtocol : word; account_signer, account_sender, account_target : Cardinal; signer_key:TECPrivateKey; n_operation : Cardinal; dataType, dataSequence : Word; AGUID : TGUID; amount, fee : UInt64; const payload: TOperationPayload);
Property Data : TOpDataData read FData;
@@ -393,6 +393,7 @@ procedure TOpChangeAccountInfo.InitializeData(AProtocolVersion : Word);
function TOpChangeAccountInfo.IsValidSignatureBasedOnCurrentSafeboxState(ASafeBoxTransaction: TPCSafeBoxTransaction): Boolean;
var LAccount : TAccount;
begin
+ if (FData.account_signer<0) or (FData.account_signer>=ASafeBoxTransaction.FreezedSafeBox.AccountsCount) then Exit(False); // Preventing exception
LAccount := ASafeBoxTransaction.Account(FData.account_signer);
Result := IsValidECDSASignature(LAccount.accountInfo.accountkey,FData.sign);
end;
@@ -549,7 +550,7 @@ function TOpChangeAccountInfo.DoOperation(AccountPreviousUpdatedBlock : TAccount
end;
If (account_name in FData.changes_type) then begin
If (Length(FData.new_name)>0) then begin
- If Not TPCSafeBox.ValidAccountName(FData.new_name,errors) then Exit;
+ If Not TPascalCoinProtocol.IsValidAccountName(AccountTransaction.FreezedSafeBox.CurrentProtocol,FData.new_name,errors) then Exit;
end;
end else begin
If (Length(FData.new_name)>0) then begin
@@ -655,7 +656,7 @@ function TOpChangeAccountInfo.N_Operation: Cardinal;
Result := FData.n_operation;
end;
-procedure TOpChangeAccountInfo.AffectedAccounts(list: TList);
+procedure TOpChangeAccountInfo.AffectedAccounts(list: TOrderedList);
begin
list.Add(FData.account_signer);
if (FData.account_target<>FData.account_signer) then list.Add(FData.account_target);
@@ -774,7 +775,7 @@ function TOpChangeAccountInfo.GetDigestToSign: TRawBytes;
{ TOpTransaction }
-procedure TOpTransaction.AffectedAccounts(list: TList);
+procedure TOpTransaction.AffectedAccounts(list: TOrderedList);
begin
list.Add(FData.sender);
list.Add(FData.target);
@@ -1133,6 +1134,7 @@ procedure TOpTransaction.InitializeData;
function TOpTransaction.IsValidSignatureBasedOnCurrentSafeboxState(ASafeBoxTransaction: TPCSafeBoxTransaction): Boolean;
var LAccount : TAccount;
begin
+ if (FData.sender<0) or (FData.sender>=ASafeBoxTransaction.FreezedSafeBox.AccountsCount) then Exit(False); // Preventing exception
LAccount := ASafeBoxTransaction.Account(FData.sender);
Result := IsValidECDSASignature(LAccount.accountInfo.accountkey,FData.sign);
end;
@@ -1335,6 +1337,13 @@ function TOpTransaction.toString: String;
TAccountComp.FormatMoney(FData.AccountPrice), TAccountComp.AccountNumberToAccountTxtNumber(FData.SellerAccount),
TAccountComp.FormatMoney(FData.amount),TAccountComp.FormatMoney(FData.fee),FData.n_operation,Length(FData.payload.payload_raw),
TCrypto.ToHexaString(FData.payload.payload_raw)]);
+ transaction_with_auto_atomic_swap :
+ Result := Format('Transaction/Swap account %s by %s paying %s to %s amount:%s fee:%s (n_op:%d) payload size:%d payload:%s',[
+ TAccountComp.AccountNumberToAccountTxtNumber(FData.target),
+ TAccountComp.AccountNumberToAccountTxtNumber(FData.sender),
+ TAccountComp.FormatMoney(FData.AccountPrice), TAccountComp.AccountNumberToAccountTxtNumber(FData.SellerAccount),
+ TAccountComp.FormatMoney(FData.amount),TAccountComp.FormatMoney(FData.fee),FData.n_operation,Length(FData.payload.payload_raw),
+ TCrypto.ToHexaString(FData.payload.payload_raw)]);
else raise Exception.Create('ERROR DEV 20170424-2');
end;
end;
@@ -1385,7 +1394,7 @@ function TOpTransaction.GetDigestToSign: TRawBytes;
{ TOpChangeKey }
-procedure TOpChangeKey.AffectedAccounts(list: TList);
+procedure TOpChangeKey.AffectedAccounts(list: TOrderedList);
begin
list.Add(FData.account_signer);
if (FData.account_target<>FData.account_signer) then list.Add(FData.account_target);
@@ -1458,7 +1467,7 @@ function TOpChangeKey.DoOperation(AccountPreviousUpdatedBlock : TAccountPrevious
Exit;
end;
if (account_signer.balanceCT_MaxPayloadSize) then begin
@@ -1572,6 +1581,7 @@ procedure TOpChangeKey.InitializeData(AProtocolVersion : Word);
function TOpChangeKey.IsValidSignatureBasedOnCurrentSafeboxState(ASafeBoxTransaction: TPCSafeBoxTransaction): Boolean;
var LAccount : TAccount;
begin
+ if (FData.account_signer<0) or (FData.account_signer>=ASafeBoxTransaction.FreezedSafeBox.AccountsCount) then Exit(False); // Preventing exception
LAccount := ASafeBoxTransaction.Account(FData.account_signer);
Result := IsValidECDSASignature(LAccount.accountInfo.accountkey,FData.sign);
end;
@@ -1732,7 +1742,7 @@ class function TOpChangeKeySigned.OpType: Byte;
{ TOpRecoverFounds }
-procedure TOpRecoverFounds.AffectedAccounts(list: TList);
+procedure TOpRecoverFounds.AffectedAccounts(list: TOrderedList);
begin
list.Add(FData.account);
end;
@@ -1785,6 +1795,23 @@ function TOpRecoverFounds.DoOperation(AccountPreviousUpdatedBlock : TAccountPrev
if Not TAccountComp.IsValidAccountKey(FData.new_accountkey,LSafeboxCurrentProtocol,errors) then begin
Exit;
end;
+
+ // Poll on Discord
+ // https://discordapp.com/channels/383064643482025984/391780165669093377/719437469329915945
+ // RESULTS ON 2020-07-21
+ // 1 (22 votes) - Remove PASC/PASA Recovery rule
+ // 2 (27 votes) - Recover only EMPTY non used, not named PASA's
+ // 3 (3 votes) - Change Recovery to 10 year rule
+ // 4 (2 votes) - Leave As Is.
+ // ----------
+ // Winner option 2: Will apply on next Hard Fork (Protocol 6)
+ if (LSafeboxCurrentProtocol>CT_PROTOCOL_5) then begin
+ if (acc.balance>0) or (Length(acc.name)>0) then begin
+ errors := 'Recover account is only valid for Balance 0 and unnamed accounts';
+ exit;
+ end;
+ end;
+
Result := AccountTransaction.UpdateAccountInfo(AccountPreviousUpdatedBlock,
GetOpID,
FData.account,FData.n_operation, FData.account,
@@ -1906,7 +1933,7 @@ function TOpRecoverFounds.GetDigestToSign: TRawBytes;
{ TOpListAccount }
-procedure TOpListAccount.AffectedAccounts(list: TList);
+procedure TOpListAccount.AffectedAccounts(list: TOrderedList);
begin
list.Add(FData.account_signer);
if FData.account_signer<>FData.account_target then
@@ -2043,7 +2070,7 @@ function TOpListAccount.DoOperation(AccountPreviousUpdatedBlock : TAccountPrevio
Exit;
end;
if (account_signer.balanceCT_MaxPayloadSize) then begin
@@ -2139,6 +2166,7 @@ procedure TOpListAccount.InitializeData;
function TOpListAccount.IsValidSignatureBasedOnCurrentSafeboxState(ASafeBoxTransaction: TPCSafeBoxTransaction): Boolean;
var LAccount : TAccount;
begin
+ if (FData.account_signer<0) or (FData.account_signer>=ASafeBoxTransaction.FreezedSafeBox.AccountsCount) then Exit(False); // Preventing exception
LAccount := ASafeBoxTransaction.Account(FData.account_signer);
Result := IsValidECDSASignature(LAccount.accountInfo.accountkey,FData.sign);
end;
@@ -2550,6 +2578,7 @@ procedure TOpData.InitializeData(AProtocolVersion : Word);
function TOpData.IsValidSignatureBasedOnCurrentSafeboxState(ASafeBoxTransaction: TPCSafeBoxTransaction): Boolean;
var LAccount : TAccount;
begin
+ if (FData.account_signer<0) or (FData.account_signer>=ASafeBoxTransaction.FreezedSafeBox.AccountsCount) then Exit(False); // Preventing exception
LAccount := ASafeBoxTransaction.Account(FData.account_signer);
Result := IsValidECDSASignature(LAccount.accountInfo.accountkey,FData.sign);
end;
@@ -2793,7 +2822,7 @@ function TOpData.N_Operation: Cardinal;
Result := FData.n_operation;
end;
-procedure TOpData.AffectedAccounts(list: TList);
+procedure TOpData.AffectedAccounts(list: TOrderedList);
begin
list.Add(FData.account_signer);
if (FData.account_signer<>FData.account_sender) then begin
diff --git a/src/core/UPCAbstractMem.pas b/src/core/UPCAbstractMem.pas
index 189556d6f..54767539e 100644
--- a/src/core/UPCAbstractMem.pas
+++ b/src/core/UPCAbstractMem.pas
@@ -6,12 +6,16 @@ interface
{$MODE DELPHI}
{$ENDIF}
+{$I ./../config.inc}
+
uses Classes, SysUtils, SyncObjs,
- UAbstractMem, UFileMem, UAbstractMemTList,
- UAbstractBTree, UThread,
+ UAbstractMem, UFileMem, UAbstractMemTList, UCacheMem,
+ UAbstractBTree, UThread, UAbstractMemBTree,
UAVLCache, ULog, UCrypto,
UPCAbstractMemAccountKeys,
UPCDataTypes, UBaseTypes, UConst, UPCSafeBoxRootHash, UOrderedList,
+ UPCAccountsOrdenations,
+ UPCAbstractMemAccounts,
{$IFNDEF FPC}System.Generics.Collections,System.Generics.Defaults{$ELSE}Generics.Collections,Generics.Defaults{$ENDIF};
type
@@ -34,8 +38,6 @@ TPCAbstractMemListBlocks = class(TAbstractMemTList)
procedure SaveTo(const AItem: TOperationBlockExt; AIsAddingItem : Boolean; var ABytes: TBytes); override;
end;
- TPCAbstractMemListAccounts = class;
-
TAccountNameInfo = record
accountName: string;
accountNumber: cardinal;
@@ -43,30 +45,22 @@ TAccountNameInfo = record
{ TPCAbstractMemListAccountNames }
- TPCAbstractMemListAccountNames = class(TAbstractMemOrderedTList)
+ TPCAbstractMemListAccountNames = Class(TAbstractMemBTreeData)
private
FPCAbstractMem: TPCAbstractMem;
+ procedure LoadFrom(const ABytes: TBytes; var AItem: TAccountNameInfo);
+ procedure SaveTo(const AItem: TAccountNameInfo; var ABytes: TBytes);
+ function FindByName(const AName : String; out AAbstractMemPosition : TAbstractMemPosition) : Boolean; overload;
protected
- function ToString(const AItem: TAccountNameInfo): string; override;
-
- procedure LoadFrom(const ABytes: TBytes; var AItem: TAccountNameInfo); override;
- procedure SaveTo(const AItem: TAccountNameInfo; AIsAddingItem : Boolean; var ABytes: TBytes); override;
- function Compare(const ALeft, ARight: TAccountNameInfo): integer; override;
+ function LoadData(const APosition : TAbstractMemPosition) : TAccountNameInfo; override;
+ function SaveData(const AData : TAccountNameInfo) : TAMZone; override;
public
- function IndexOf(const AName : String) : Integer;
- procedure Remove(const AName : String);
- procedure Add(const AName : String; AAccountNumber : Cardinal);
- function FindByName(const AName : String; out AIndex : Integer) : Boolean;
- end;
-
- { TPCAbstractMemListAccounts }
-
- TPCAbstractMemListAccounts = class(TAbstractMemTList)
- private
- FPCAbstractMem: TPCAbstractMem;
- protected
- procedure LoadFrom(const ABytes: TBytes; var AItem: TAccount); override;
- procedure SaveTo(const AItem: TAccount; AIsAddingItem : Boolean; var ABytes: TBytes); override;
+ function NodeDataToString(const AData : TAbstractMemPosition) : String; override;
+ // Special
+ procedure AddNameAndNumber(const AName : String; AAccountNumber : Cardinal);
+ function FindByName(const AName : String) : Boolean; overload;
+ function FindByName(const AName : String; out ANameInfo : TAccountNameInfo) : Boolean; overload;
+ function DeleteAccountName(const AName : String) : Boolean;
end;
{ TPCAbstractMemBytesBuffer32Safebox }
@@ -77,7 +71,7 @@ TPCAbstractMemListAccounts = class(TAbstractMemTList)
FSaveBufferPosition : TAbstractMemPosition;
protected
public
- Constructor Create(AAbstractMem : TAbstractMem; APosition : TAbstractMemPosition; ACurrBlocksCount : Integer);
+ Constructor Create(AAbstractMem : TAbstractMem; APosition : TAbstractMemPosition; ACurrBlocksCount : Integer); reintroduce;
procedure Flush;
end;
@@ -90,7 +84,7 @@ TPCAbstractMemListAccounts = class(TAbstractMemTList)
procedure BCExecute; override;
public
Constructor Create(APCAbstractMem : TPCAbstractMem);
- Destructor Destroy;
+ Destructor Destroy; override;
procedure Restart;
property Errors : TStrings read FErrors;
End;
@@ -98,6 +92,13 @@ TPCAbstractMemListAccounts = class(TAbstractMemTList)
TAccountCache = Class(TAVLCache)
End;
+ TPCAbstractMemStats = Record
+ FlushesCount : Integer;
+ FlushesMillis : TTickCount;
+ function ToString : String;
+ procedure Clear;
+ end;
+
TPCAbstractMem = class
private
FFileName : String;
@@ -105,6 +106,8 @@ TPCAbstractMem = class
FCheckingThread : TPCAbstractMemCheckThread;
FLockAbstractMem : TPCCriticalSection;
+ FStats : TPCAbstractMemStats;
+
FBlocks: TPCAbstractMemListBlocks;
FAccounts: TPCAbstractMemListAccounts;
FAccountsNames: TPCAbstractMemListAccountNames;
@@ -113,6 +116,14 @@ TPCAbstractMem = class
FBufferBlocksHash: TPCAbstractMemBytesBuffer32Safebox;
FAggregatedHashrate : TBigNum;
FZoneAggregatedHashrate : TAMZone;
+ FUseCacheOnAbstractMemLists: Boolean;
+ FMaxMemUsage: Integer;
+ FSavingNewSafeboxMode: Boolean;
+
+ FSavingOldGridCache : Boolean;
+ FSavingOldDefaultCacheDataBlocksSize : Integer;
+ FAccountsOrderedByUpdatedBlock : TAccountsOrderedByUpdatedBlock;
+ FAccountsOrderedBySalePrice : TAccountsOrderedBySalePrice;
function IsChecking : Boolean;
procedure DoCheck;
@@ -121,8 +132,18 @@ TPCAbstractMem = class
procedure AddBlockInfo(const ABlock : TOperationBlockExt);
procedure SetBlockInfo(const ABlock : TOperationBlockExt);
function DoInit(out AIsNewStructure : Boolean) : Boolean;
+ procedure SetMaxMemUsage(const Value: Integer);
+ procedure SetUseCacheOnAbstractMemLists(const Value: Boolean);
+ procedure SetMaxAccountsCache(const Value: Integer);
+ function GetMaxAccountsCache: Integer;
+ function GetMaxAccountKeysCache: Integer;
+ procedure SetMaxAccountKeysCache(const Value: Integer);
+ procedure SetSavingNewSafeboxMode(const Value: Boolean);
+ procedure OnCacheMemFlushedCache(const ASender : TCacheMem; const AProcessDesc : String; AElapsedMilis: Int64);
+ procedure OnCacheMemLog(ASender : TObject; const ALog : String);
protected
procedure UpgradeAbstractMemVersion(const ACurrentHeaderVersion : Integer);
+ function DoGetAccount(AAccountNumber : Integer; var AAccount : TAccount) : Boolean;
public
constructor Create(const ASafeboxFileName: string; AReadOnly: boolean);
class function AnalyzeFile(const ASafeboxFileName: string; var ABlocksCount : Integer) : Boolean;
@@ -156,6 +177,15 @@ TPCAbstractMem = class
property AccountCache : TAccountCache read FAccountCache;
property FileName : String read FFileName;
procedure EraseData;
+ function GetStatsReport(AClearStats : Boolean) : String;
+ //
+ Property UseCacheOnAbstractMemLists : Boolean read FUseCacheOnAbstractMemLists write SetUseCacheOnAbstractMemLists;
+ Property MaxMemUsage : Integer read FMaxMemUsage write SetMaxMemUsage;
+ Property MaxAccountsCache : Integer read GetMaxAccountsCache write SetMaxAccountsCache;
+ Property MaxAccountKeysCache : Integer read GetMaxAccountKeysCache write SetMaxAccountKeysCache;
+ Property SavingNewSafeboxMode : Boolean read FSavingNewSafeboxMode write SetSavingNewSafeboxMode;
+ Property AccountsOrderedByUpdatedBlock : TAccountsOrderedByUpdatedBlock read FAccountsOrderedByUpdatedBlock;
+ Property AccountsOrderedBySalePrice : TAccountsOrderedBySalePrice read FAccountsOrderedBySalePrice;
end;
implementation
@@ -163,8 +193,8 @@ implementation
uses UAccounts;
const
- CT_PCAbstractMem_FileVersion = CT_PROTOCOL_5;
- CT_PCAbstractMem_HeaderVersion = 1;
+ CT_PCAbstractMem_FileVersion = 100;
+ CT_PCAbstractMem_HeaderVersion = 3;
function _AccountCache_Comparision(const Left, Right: TAccountCache.PAVLCacheMemData): Integer;
begin
@@ -180,7 +210,7 @@ constructor TPCAbstractMemBytesBuffer32Safebox.Create(AAbstractMem : TAbstractMe
LCachedSafeboxHash : TBytes;
begin
FCachedSafeboxHash := Nil;
- inherited Create(1000*32);
+ inherited Create(100000*32);
FAbstractMem := AAbstractMem;
FSaveBufferPosition:=APosition;
if (APosition>0) then begin
@@ -231,145 +261,6 @@ procedure TPCAbstractMemBytesBuffer32Safebox.Flush;
end;
end;
-{ TPCAbstractMemListAccounts }
-
-procedure TPCAbstractMemListAccounts.LoadFrom(const ABytes: TBytes; var AItem: TAccount);
-var
- LPointer: TAbstractMemPosition;
- LStream : TStream;
- w : Word;
-begin
- AItem.Clear;
- LStream := TMemoryStream.Create;
- Try
- LPointer := 0;
- LStream.Write(ABytes[0],Length(ABytes));
- LStream.Position := 0;
-
- LStream.Read( AItem.account , 4 );
-
- LStream.Read( w,2 );
- if (w<>CT_PROTOCOL_5) then raise EPCAbstractMem.Create(Format('Invalid Account %d protocol %d',[AItem.account,w]));
-
- LStream.Read( w, 2 );
- case w of
- CT_NID_secp256k1,CT_NID_secp384r1,CT_NID_sect283k1,CT_NID_secp521r1 : Begin
- AItem.accountInfo.state := as_Normal;
- LStream.Read(LPointer,4);
- AItem.accountInfo.accountKey := FPCAbstractMem.FAccountKeys.GetKeyAtPosition( LPointer );
- if w<>AItem.accountInfo.accountKey.EC_OpenSSL_NID then raise EPCAbstractMem.Create('INCONSISTENT 20200318-2');
- End;
- CT_AccountInfo_ForSale, CT_AccountInfo_ForAccountSwap, CT_AccountInfo_ForCoinSwap : Begin
- case w of
- CT_AccountInfo_ForSale : AItem.accountInfo.state := as_ForSale;
- CT_AccountInfo_ForAccountSwap : AItem.accountInfo.state := as_ForAtomicAccountSwap;
- CT_AccountInfo_ForCoinSwap : AItem.accountInfo.state := as_ForAtomicCoinSwap;
- end;
- LStream.Read(LPointer,4);
- AItem.accountInfo.accountKey := FPCAbstractMem.FAccountKeys.GetKeyAtPosition( LPointer );
-
- LStream.Read(AItem.accountInfo.locked_until_block,4);
- LStream.Read(AItem.accountInfo.price,8);
- LStream.Read(AItem.accountInfo.account_to_pay,4);
- LStream.Read(LPointer,4);
- AItem.accountInfo.new_publicKey := FPCAbstractMem.FAccountKeys.GetKeyAtPosition( LPointer );
- if (w<>CT_AccountInfo_ForSale) then begin
- AItem.accountInfo.hashed_secret.FromSerialized(LStream);
- end;
-
- End;
- else raise EPCAbstractMem.Create(Format('Unknow accountInfo type %d for account %d',[w,Aitem.account]));
- end;
- //
- LStream.Read( AItem.balance , 8);
- LStream.Read( AItem.updated_on_block_passive_mode , 4);
- LStream.Read( AItem.updated_on_block_active_mode , 4);
- LStream.Read( AItem.n_operation , 4);
- AItem.name.FromSerialized( LStream );
- LStream.Read( AItem.account_type ,2);
- AItem.account_data.FromSerialized( LStream );
- if AItem.account_seal.FromSerialized( LStream )<0 then raise EPCAbstractMem.Create('INCONSISTENT 20200318-4');
- // Force account_seal to 20 bytes
- if Length(AItem.account_seal)<>20 then begin
- AItem.account_seal := TBaseType.T20BytesToRawBytes( TBaseType.To20Bytes(AItem.account_seal) );
- end;
- Finally
- LStream.Free;
- End;
-end;
-
-procedure TPCAbstractMemListAccounts.SaveTo(const AItem: TAccount; AIsAddingItem : Boolean; var ABytes: TBytes);
-var LStream : TStream;
- LPointer : TAbstractMemPosition;
- w : Word;
- LPrevious : TAccount;
-begin
- if (Length(ABytes)>0) and (Not AIsAddingItem) then begin
- // Capture previous values
- LoadFrom(ABytes,LPrevious);
- if (LPrevious.account<>AItem.account) then raise EPCAbstractMem.Create(Format('INCONSISTENT account number %d<>%d',[AItem.account,LPrevious.account]));
-
- if Not LPrevious.accountInfo.accountKey.IsEqualTo( AItem.accountInfo.accountKey ) then begin
- // Remove previous account link
- FPCAbstractMem.FAccountKeys.GetPositionOfKeyAndRemoveAccount( LPrevious.accountInfo.accountKey, LPrevious.account );
- end;
- end;
-
- LStream := TMemoryStream.Create;
- try
- LStream.Position := 0;
-
-
- LStream.Write( AItem.account , 4 );
-
- w := CT_PROTOCOL_5;
- LStream.Write( w, 2 );
-
- w := 0;
- case AItem.accountInfo.state of
- as_Normal : begin
- LPointer := FPCAbstractMem.FAccountKeys.GetPositionOfKeyAndAddAccount(AItem.accountInfo.accountKey,AItem.account);
- LStream.Write( AItem.accountInfo.accountKey.EC_OpenSSL_NID , 2 );
- LStream.Write( LPointer, 4);
- end;
- as_ForSale : w := CT_AccountInfo_ForSale;
- as_ForAtomicAccountSwap : w := CT_AccountInfo_ForAccountSwap;
- as_ForAtomicCoinSwap : w := CT_AccountInfo_ForCoinSwap;
- end;
- if (w>0) then begin
- LStream.Write(w,2);
-
- LPointer := FPCAbstractMem.FAccountKeys.GetPositionOfKeyAndAddAccount(AItem.accountInfo.accountKey,AItem.account);
- LStream.Write( LPointer, 4);
-
- LStream.Write(AItem.accountInfo.locked_until_block,4);
- LStream.Write(AItem.accountInfo.price,8);
- LStream.Write(AItem.accountInfo.account_to_pay,4);
- LPointer := FPCAbstractMem.FAccountKeys.GetPositionOfKey(AItem.accountInfo.new_publicKey,True);
- LStream.Write(LPointer,4);
- if (w<>CT_AccountInfo_ForSale) then begin
- AItem.accountInfo.hashed_secret.ToSerialized(LStream);
- end;
- end;
- //
- LStream.Write( AItem.balance , 8);
- LStream.Write( AItem.updated_on_block_passive_mode , 4);
- LStream.Write( AItem.updated_on_block_active_mode , 4);
- LStream.Write( AItem.n_operation , 4);
-
- AItem.name.ToSerialized( LStream );
-
- LStream.Write( AItem.account_type ,2);
- AItem.account_data.ToSerialized( LStream );
- AItem.account_seal.ToSerialized( LStream );
- //
- ABytes.FromStream( LStream );
-
- finally
- LStream.Free;
- end;
-end;
-
{ TPCAbstractMem }
function TPCAbstractMem.CheckConsistency(AReport: TStrings) : Boolean;
@@ -403,9 +294,16 @@ procedure TPCAbstractMem.CopyFrom(ASource: TPCAbstractMem);
begin
ASource.FlushCache;
FAbstractMem.CopyFrom(ASource.FAbstractMem);
+ FUseCacheOnAbstractMemLists := ASource.FUseCacheOnAbstractMemLists;
+ FMaxMemUsage := ASource.FMaxMemUsage;
DoInit(LIsNew);
end;
+function _TComparison_TAccountNameInfo(const ALeft, ARight : TAccountNameInfo) : Integer;
+begin
+ Result := CompareText(ALeft.accountName,ARight.accountName);
+end;
+
function TPCAbstractMem.DoInit(out AIsNewStructure : Boolean) : Boolean;
const
CT_HEADER_MIN_SIZE = 100;
@@ -420,6 +318,8 @@ function TPCAbstractMem.DoInit(out AIsNewStructure : Boolean) : Boolean;
[28..31] 4 bytes: LZoneAccountKeys.position
[32..35] 4 bytes: FZoneAggregatedHashrate.position
[36..39] 4 bytes: LZoneBuffersBlockHash
+ [40..43] 4 bytes: LZoneAccountsOrderedByUpdatedBlock.position
+ [44..47] 4 bytes: LZoneAccountsOrderedBySalePrice.position
...
[96..99] 4 bytes: Header version
}
@@ -427,7 +327,9 @@ function TPCAbstractMem.DoInit(out AIsNewStructure : Boolean) : Boolean;
LZoneBlocks,
LZoneAccounts,
LZoneAccountsNames,
- LZoneAccountKeys : TAMZone;
+ LZoneAccountKeys,
+ LZoneAccountsOrderedByUpdatedBlock,
+ LZoneAccountsOrderedBySalePrice : TAMZone;
LZoneBuffersBlockHash : TAbstractMemPosition;
LHeader, LBuffer, LBigNum : TBytes;
LIsGood : Boolean;
@@ -441,6 +343,8 @@ function TPCAbstractMem.DoInit(out AIsNewStructure : Boolean) : Boolean;
FreeAndNil(FAccountsNames);
FreeAndNil(FAccountKeys);
FreeAndNil(FBufferBlocksHash);
+ FreeAndNil(FAccountsOrderedByUpdatedBlock);
+ FreeAndNil(FAccountsOrderedBySalePrice);
//
Result := False;
AIsNewStructure := True;
@@ -451,6 +355,8 @@ function TPCAbstractMem.DoInit(out AIsNewStructure : Boolean) : Boolean;
LZoneAccountKeys.Clear;
FZoneAggregatedHashrate.Clear;
LZoneBuffersBlockHash := 0;
+ LZoneAccountsOrderedByUpdatedBlock.Clear;
+ LZoneAccountsOrderedBySalePrice.Clear;
if (FAbstractMem.ReadFirstData(LZone,LHeader)) then begin
// Check if header is valid:
@@ -473,18 +379,34 @@ function TPCAbstractMem.DoInit(out AIsNewStructure : Boolean) : Boolean;
Move(LHeader[28], LZoneAccountKeys.position, 4);
Move(LHeader[32], FZoneAggregatedHashrate.position, 4);
LZoneBuffersBlockHash := LZone.position + 36;
+ Move(LHeader[40], LZoneAccountsOrderedByUpdatedBlock.position, 4);
+ Move(LHeader[44], LZoneAccountsOrderedBySalePrice.position, 4);
+ //
Move(LHeader[96], LHeaderVersion, 4);
if (LHeaderVersion>CT_PCAbstractMem_HeaderVersion) then begin
TLog.NewLog(lterror,ClassName,Format('Header version readed %d is greater than expected %d',[LHeaderVersion,CT_PCAbstractMem_HeaderVersion]));
end else begin
AIsNewStructure := False;
+ //
+ if (Not FAbstractMem.ReadOnly) then begin
+ if (LZoneAccountsOrderedByUpdatedBlock.position=0) then begin
+ LZoneAccountsOrderedByUpdatedBlock := FAbstractMem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize(FAbstractMem));
+ Move(LZoneAccountsOrderedByUpdatedBlock.position,LHeader[40],4);
+ FAbstractMem.Write(LZone.position,LHeader[0],Length(LHeader));
+ end;
+ if (LZoneAccountsOrderedBySalePrice.position=0) then begin
+ LZoneAccountsOrderedBySalePrice := FAbstractMem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize(FAbstractMem));
+ Move(LZoneAccountsOrderedBySalePrice.position,LHeader[44],4);
+ FAbstractMem.Write(LZone.position,LHeader[0],Length(LHeader));
+ end;
+ end;
end;
end;
end;
end;
if (Not FAbstractMem.ReadOnly) and (AIsNewStructure) then begin
// Initialize struct
- FAbstractMem.ClearContent;
+ FAbstractMem.ClearContent(FAbstractMem.Is64Bits);
LZone := FAbstractMem.New( CT_HEADER_MIN_SIZE ); // Header zone
SetLength(LHeader,100);
FillChar(LHeader[0],Length(LHeader),0);
@@ -493,12 +415,16 @@ function TPCAbstractMem.DoInit(out AIsNewStructure : Boolean) : Boolean;
Move(LBuffer[0],LHeader[0],14);
w := CT_PCAbstractMem_FileVersion;
Move(w,LHeader[14],2);
- LZoneBlocks := FAbstractMem.New( CT_AbstractMemTList_HeaderSize );
- LZoneAccounts := FAbstractMem.New( CT_AbstractMemTList_HeaderSize );
- LZoneAccountsNames := FAbstractMem.New( CT_AbstractMemTList_HeaderSize );
+ LZoneBlocks := FAbstractMem.New( TAbstractMemTList.MinAbstractMemTListHeaderSize(FAbstractMem) );
+ LZoneAccounts := FAbstractMem.New( TAbstractMemTList.MinAbstractMemTListHeaderSize(FAbstractMem) );
+ LZoneAccountsNames := FAbstractMem.New( TAbstractMemTList.MinAbstractMemTListHeaderSize(FAbstractMem) );
LZoneAccountKeys := FAbstractMem.New( 100 );
FZoneAggregatedHashrate := FAbstractMem.New(100); // Note: Enough big to store a BigNum
LZoneBuffersBlockHash := LZone.position+36;
+ LZoneAccountsOrderedByUpdatedBlock := FAbstractMem.New(
+ TAbstractMemBTree.MinAbstractMemInitialPositionSize(FAbstractMem));
+ LZoneAccountsOrderedBySalePrice := FAbstractMem.New(
+ TAbstractMemBTree.MinAbstractMemInitialPositionSize(FAbstractMem));
Move(LZoneBlocks.position, LHeader[16],4);
Move(LZoneAccounts.position, LHeader[20],4);
@@ -506,6 +432,8 @@ function TPCAbstractMem.DoInit(out AIsNewStructure : Boolean) : Boolean;
Move(LZoneAccountKeys.position, LHeader[28],4);
Move(FZoneAggregatedHashrate.position,LHeader[32],4);
LHeaderVersion := CT_PCAbstractMem_HeaderVersion;
+ Move(LZoneAccountsOrderedByUpdatedBlock, LHeader[40],4);
+ Move(LZoneAccountsOrderedBySalePrice, LHeader[44],4);
Move(LHeaderVersion, LHeader[96],4);
FAbstractMem.Write(LZone.position,LHeader[0],Length(LHeader));
@@ -514,13 +442,17 @@ function TPCAbstractMem.DoInit(out AIsNewStructure : Boolean) : Boolean;
// Free
FreeAndNil(FBlocks);
//
- FBlocks := TPCAbstractMemListBlocks.Create( FAbstractMem, LZoneBlocks, 10000 );
+ FBlocks := TPCAbstractMemListBlocks.Create( FAbstractMem, LZoneBlocks, 20000, Self.UseCacheOnAbstractMemLists);
FBlocks.FPCAbstractMem := Self;
- FAccounts := TPCAbstractMemListAccounts.Create( FAbstractMem, LZoneAccounts, 50000);
- FAccounts.FPCAbstractMem := Self;
- FAccountsNames := TPCAbstractMemListAccountNames.Create( FAbstractMem, LZoneAccountsNames, 5000 , False);
+
+ FAccounts := TPCAbstractMemListAccounts.Create( FAbstractMem, LZoneAccounts, 100000, Self.UseCacheOnAbstractMemLists);
+
+ FAccountsNames := TPCAbstractMemListAccountNames.Create( FAbstractMem, LZoneAccountsNames, False, 31, _TComparison_TAccountNameInfo);
FAccountsNames.FPCAbstractMem := Self;
- FAccountKeys := TPCAbstractMemAccountKeys.Create( FAbstractMem, LZoneAccountKeys.position );
+
+ FAccountKeys := TPCAbstractMemAccountKeys.Create( FAbstractMem, LZoneAccountKeys.position, Self.UseCacheOnAbstractMemLists);
+ FAccounts.AccountKeys := FAccountKeys;
+
// Read AggregatedHashrate
SetLength(LBuffer,100);
FAbstractMem.Read(FZoneAggregatedHashrate.position,LBuffer[0],Length(LBuffer));
@@ -529,6 +461,12 @@ function TPCAbstractMem.DoInit(out AIsNewStructure : Boolean) : Boolean;
end;
FBufferBlocksHash := TPCAbstractMemBytesBuffer32Safebox.Create(FAbstractMem,LZoneBuffersBlockHash,FBlocks.Count);
+ FAccountsOrderedByUpdatedBlock := TAccountsOrderedByUpdatedBlock.Create({$IFDEF USE_ABSTRACTMEM}FAbstractMem,LZoneAccountsOrderedByUpdatedBlock,{$ENDIF}DoGetAccount);
+ FAccounts.AccountsOrderedByUpdatedBlock := FAccountsOrderedByUpdatedBlock;
+
+ FAccountsOrderedBySalePrice := TAccountsOrderedBySalePrice.Create({$IFDEF USE_ABSTRACTMEM}FAbstractMem,LZoneAccountsOrderedBySalePrice,{$ENDIF}DoGetAccount);
+ FAccounts.AccountsOrderedBySalePrice := FAccountsOrderedBySalePrice;
+
FAccountCache.Clear;
if (Not AIsNewStructure) And (Not FAbstractMem.ReadOnly) And (LHeaderVersion'') {and (FileExists(ASafeboxFileName))} then begin
+ if (FFileName<>'') then begin
FAbstractMem := TFileMem.Create( ASafeboxFileName , AReadOnly);
end else begin
FAbstractMem := TMem.Create(0,AReadOnly);
end;
+
if FAbstractMem is TFileMem then begin
- TFileMem(FAbstractMem).MaxCacheSize := 40 * 1024 * 1024; // 40Mb
- TFileMem(FAbstractMem).MaxCacheDataBlocks := 200000;
+ TFileMem(FAbstractMem).IncreaseFileBytes := 10 * 1024*1024; // 10Mb each increase
+ TFileMem(FAbstractMem).SetCachePerformance(True,1024,FMaxMemUsage,400000);
+ LCacheMem := TFileMem(FAbstractMem).LockCache;
+ Try
+ LCacheMem.OnFlushedCache := OnCacheMemFlushedCache;
+ LCacheMem.OnLog := OnCacheMemLog;
+ Finally
+ TFileMem(FAbstractMem).UnlockCache;
+ End;
end;
DoInit(LIsNewStructure);
@@ -598,6 +557,8 @@ destructor TPCAbstractMem.Destroy;
FreeAndNil(FAccountKeys);
FreeAndNil(FBufferBlocksHash);
FreeAndNil(FAggregatedHashrate);
+ FreeAndNil(FAccountsOrderedByUpdatedBlock);
+ FreeAndNil(FAccountsOrderedBySalePrice);
if (FFileName<>'') And (FAbstractMem is TMem) And (Not FAbstractMem.ReadOnly) then begin
LFile := TFileStream.Create(FFileName,fmCreate);
try
@@ -629,13 +590,20 @@ procedure TPCAbstractMem.DoCheck;
End;
end;
+function TPCAbstractMem.DoGetAccount(AAccountNumber: Integer; var AAccount: TAccount): Boolean;
+begin
+ AAccount := GetAccount(AAccountNumber);
+ Result := True;
+end;
+
procedure TPCAbstractMem.FlushCache;
var LBigNum : TBytes;
+ Ltc : TTickCount;
begin
if FAbstractMem.ReadOnly then Exit;
+ Ltc := TPlatform.GetTickCount;
FBlocks.FlushCache;
FAccounts.FlushCache;
- FAccountsNames.FlushCache;
FAccountKeys.FlushCache;
FBufferBlocksHash.Flush;
LBigNum := FAggregatedHashrate.RawValue.ToSerialized;
@@ -643,6 +611,9 @@ procedure TPCAbstractMem.FlushCache;
if FAbstractMem is TFileMem then begin
TFileMem(FAbstractMem).FlushCache;
end;
+ Inc(FStats.FlushesCount);
+ Inc(Fstats.FlushesMillis, TPlatform.GetElapsedMilliseconds(Ltc) );
+ TLog.NewLog(ltdebug,Self.ClassName,Format('AbstractMem Safebox flushed in %.2f seconds',[TPlatform.GetElapsedMilliseconds(Ltc)/1000]));
end;
Procedure DoCopyFile(const ASource, ADest : String);
@@ -692,13 +663,13 @@ procedure TPCAbstractMem.SetAccount(const AAccount: TAccount);
if (AAccount.account<0) or (AAccount.account>FAccounts.Count) then begin
raise EPCAbstractMem.Create(Format('Account %d not in range %d..%d',[AAccount.account,0,FAccounts.Count]));
end;
- FAccountCache.Remove(AAccount);
if (AAccount.account = FAccounts.Count) then begin
FAccounts.Add(AAccount);
end else begin
- FAccounts.SetItem( AAccount.account , AAccount);
+ FAccounts.Item[ AAccount.account ] := AAccount;
end;
// Update cache
+ FAccountCache.Remove(AAccount);
FAccountCache.Add(AAccount);
end;
@@ -773,8 +744,59 @@ procedure TPCAbstractMem.SetBlockInfo(const ABlock: TOperationBlockExt);
end else raise EPCAbstractMem.Create(Format('Cannot set block info %d (current %d blocks)',[ABlock.operationBlock.block,LCount]));
end;
+procedure TPCAbstractMem.SetMaxAccountKeysCache(const Value: Integer);
+begin
+ FAccountKeys.AccountKeyByPositionCache.MaxRegisters := Value;
+end;
+
+procedure TPCAbstractMem.SetMaxAccountsCache(const Value: Integer);
+begin
+ FAccountCache.MaxRegisters := Value;
+end;
+
+procedure TPCAbstractMem.SetMaxMemUsage(const Value: Integer);
+begin
+ FMaxMemUsage := Value;
+ if FAbstractMem is TFileMem then begin
+ TFileMem(FAbstractMem).SetCachePerformance(True,1024,FMaxMemUsage,200000);
+ end;
+end;
+
+procedure TPCAbstractMem.SetSavingNewSafeboxMode(const Value: Boolean);
+var Lcm : TCacheMem;
+begin
+ FSavingNewSafeboxMode := Value;
+ // Will set in optimized state (cache and others) for maximum performance and minimum impact
+ TLog.NewLog(ltinfo,ClassName,Format('Seting AbstractMem is Saving mode:%s',[Value.ToString]));
+ if FAbstractMem is TFileMem then begin
+ Lcm := TFileMem(FAbstractMem).LockCache;
+ try
+ if Value then begin
+ FSavingOldGridCache := Lcm.GridCache;
+ FSavingOldDefaultCacheDataBlocksSize := Lcm.DefaultCacheDataBlocksSize;
+ Lcm.GridCache := False;
+ Lcm.DefaultCacheDataBlocksSize := -1;
+ end else begin
+ Lcm.GridCache := FSavingOldGridCache;
+ Lcm.DefaultCacheDataBlocksSize := FSavingOldDefaultCacheDataBlocksSize;
+ end;
+ finally
+ TFileMem(FAbstractMem).UnlockCache;
+ end;
+ end;
+end;
+
+procedure TPCAbstractMem.SetUseCacheOnAbstractMemLists(const Value: Boolean);
+var Lins : Boolean;
+begin
+ if Value=FUseCacheOnAbstractMemLists then Exit;
+ FUseCacheOnAbstractMemLists := Value;
+ DoInit(Lins);
+end;
+
procedure TPCAbstractMem.UpdateSafeboxFileName(const ANewSafeboxFileName: String);
var LReadOnly, Ltmp : Boolean;
+ LCacheMem : TCacheMem;
begin
if SameFileName(FFileName,ANewSafeboxFileName) then Exit;
@@ -791,8 +813,14 @@ procedure TPCAbstractMem.UpdateSafeboxFileName(const ANewSafeboxFileName: String
FAbstractMem := TMem.Create(0,LReadOnly);
end;
if FAbstractMem is TFileMem then begin
- TFileMem(FAbstractMem).MaxCacheSize := 40 * 1024 * 1024; // 40Mb
- TFileMem(FAbstractMem).MaxCacheDataBlocks := 200000;
+ TFileMem(FAbstractMem).SetCachePerformance(True,1024,FMaxMemUsage,200000);
+ LCacheMem := TFileMem(FAbstractMem).LockCache;
+ Try
+ LCacheMem.OnFlushedCache := OnCacheMemFlushedCache;
+ LCacheMem.OnLog := OnCacheMemLog;
+ Finally
+ TFileMem(FAbstractMem).UnlockCache;
+ End;
end;
DoInit(Ltmp);
end;
@@ -801,24 +829,17 @@ procedure TPCAbstractMem.UpgradeAbstractMemVersion(const ACurrentHeaderVersion:
var LFirstTC, LTC : TTickCount;
i : integer;
LAccount : TAccount;
+ LaccInfoNul : TAccountInfo;
begin
LFirstTC := TPlatform.GetTickCount;
LTC := LFirstTC;
- if (ACurrentHeaderVersion=0) then begin
- // Redo AccountNames
- TLog.NewLog(ltinfo,ClassName,Format('Upgrade AbstractMem file from %d to %d with %d Accounts and %d AccNames',[ACurrentHeaderVersion,CT_PCAbstractMem_HeaderVersion, AccountsCount, AccountsNames.Count]));
- AccountsNames.Clear;
+ if (ACurrentHeaderVersion=2) then begin
+ // Set accounts price
+ LaccInfoNul.Clear;
for i := 0 to AccountsCount-1 do begin
LAccount := GetAccount(i);
- if Length(LAccount.name)>0 then begin
- AccountsNames.Add( LAccount.name.ToString, LAccount.account );
- end;
- if TPlatform.GetElapsedMilliseconds(LTC)>5000 then begin
- LTC := TPlatform.GetTickCount;
- TLog.NewLog(ltdebug,ClassName,Format('Upgrading %d/%d found %d',[i,AccountsCount,AccountsNames.Count]));
- end;
+ AccountsOrderedBySalePrice.UpdateAccountBySalePrice(LAccount.account,LaccInfoNul,LAccount.accountInfo);
end;
- TLog.NewLog(ltdebug,ClassName,Format('End upgrade found %d',[AccountsNames.Count]));
end;
TLog.NewLog(ltinfo,ClassName,Format('Finalized upgrade AbstractMem file from %d to %d in %.2f seconds',[ACurrentHeaderVersion,CT_PCAbstractMem_HeaderVersion, TPlatform.GetElapsedMilliseconds(LFirstTC)/1000]));
end;
@@ -864,6 +885,22 @@ function TPCAbstractMem.GetBlockInfo(ABlockNumber: cardinal): TOperationBlockExt
Result := FBlocks.GetItem( ABlockNumber );
end;
+function TPCAbstractMem.GetMaxAccountKeysCache: Integer;
+begin
+ Result := FAccountKeys.AccountKeyByPositionCache.MaxRegisters;
+end;
+
+function TPCAbstractMem.GetMaxAccountsCache: Integer;
+begin
+ Result := FAccountCache.MaxRegisters;
+end;
+
+function TPCAbstractMem.GetStatsReport(AClearStats: Boolean): String;
+begin
+ Result := AbstractMem.GetStatsReport(AClearStats) + #10 + FStats.ToString;
+ if AClearStats then FStats.Clear;
+end;
+
function TPCAbstractMem.IsChecking: Boolean;
begin
Result := Assigned(TPCThread.GetThreadByClass(TPCAbstractMemCheckThread,Nil));
@@ -875,6 +912,17 @@ function TPCAbstractMem.IsChecking: Boolean;
End;
end;
+procedure TPCAbstractMem.OnCacheMemFlushedCache(const ASender: TCacheMem;
+ const AProcessDesc: String; AElapsedMilis: Int64);
+begin
+ TLog.NewLog(ltdebug,ASender.ClassName,Self.ClassName+' '+AProcessDesc)
+end;
+
+procedure TPCAbstractMem.OnCacheMemLog(ASender: TObject; const ALog: String);
+begin
+ TLog.NewLog(ltdebug,ASender.ClassName,Self.ClassName+' '+ALog);
+end;
+
function TPCAbstractMem.AccountsCount: integer;
begin
Result := FAccounts.Count;
@@ -885,25 +933,25 @@ function TPCAbstractMem.GetAccount(AAccountNumber: cardinal): TAccount;
Result.Clear;
Result.account := AAccountNumber;
if Not FAccountCache.Find(Result,Result) then begin
- Result := FAccounts.GetItem( AAccountNumber );
+ Result := FAccounts.Item[ AAccountNumber ];
// Save for future usage:
FAccountCache.Add(Result);
end;
end;
-{ TPCAbstractMemListAccountNames }
-function TPCAbstractMemListAccountNames.ToString(const AItem: TAccountNameInfo): string;
-begin
- Result:= Format('AccountNameInfo: Account:%d Name(%d):%d',[AItem.accountNumber, Length(AItem.accountName), AItem.accountName]);
-end;
+{ TPCAbstractMemListAccountNames }
-function TPCAbstractMemListAccountNames.IndexOf(const AName: String): Integer;
-var LFind : TAccountNameInfo;
+function TPCAbstractMemListAccountNames.LoadData(const APosition: TAbstractMemPosition): TAccountNameInfo;
+var LZone : TAMZone;
+ LBytes : TBytes;
begin
- LFind.accountName := AName;
- LFind.accountNumber := 0;
- if Not Find(LFind,Result) then Result := -1;
+ if Not FPCAbstractMem.AbstractMem.GetUsedZoneInfo( APosition, False, LZone) then
+ raise EAbstractMemTList.Create(Format('%s.LoadData Inconsistency error used zone info not found at pos %d',[Self.ClassName,APosition]));
+ SetLength(LBytes,LZone.size);
+ if FPCAbstractMem.AbstractMem.Read(LZone.position, LBytes[0], Length(LBytes) )<>Length(LBytes) then
+ raise EAbstractMemTList.Create(Format('%s.LoadData Inconsistency error cannot read %d bytes at pos %d',[Self.ClassName,LZone.size,APosition]));
+ LoadFrom(LBytes,Result);
end;
procedure TPCAbstractMemListAccountNames.LoadFrom(const ABytes: TBytes; var AItem: TAccountNameInfo);
@@ -914,14 +962,31 @@ procedure TPCAbstractMemListAccountNames.LoadFrom(const ABytes: TBytes; var AIte
Move(ABytes[LTmp.GetSerializedLength],AItem.accountNumber,4);
end;
-procedure TPCAbstractMemListAccountNames.Remove(const AName: String);
-var i : Integer;
+function TPCAbstractMemListAccountNames.NodeDataToString(const AData: TAbstractMemPosition): String;
+var Lani : TAccountNameInfo;
+begin
+ Lani := LoadData(AData);
+ Result:= Format('AccountNameInfo: Account:%d Name(%d):%d',[Lani.accountNumber, Length(Lani.accountName), Lani.accountName]);
+end;
+
+function TPCAbstractMemListAccountNames.DeleteAccountName(const AName: String) : Boolean;
+var Lani : TAccountNameInfo;
+begin
+ Lani.accountName := AName;
+ Lani.accountNumber := 0;
+ Result := DeleteData(Lani);
+end;
+
+function TPCAbstractMemListAccountNames.SaveData(const AData: TAccountNameInfo): TAMZone;
+var LBytes : TBytes;
begin
- i := IndexOf(AName);
- if i>=0 then Delete(i);
+ SetLength(LBytes,0);
+ SaveTo(AData,LBytes);
+ Result := FPCAbstractMem.AbstractMem.New(Length(LBytes));
+ FPCAbstractMem.AbstractMem.Write(Result.position,LBytes[0],Length(LBytes));
end;
-procedure TPCAbstractMemListAccountNames.SaveTo(const AItem: TAccountNameInfo; AIsAddingItem : Boolean; var ABytes: TBytes);
+procedure TPCAbstractMemListAccountNames.SaveTo(const AItem: TAccountNameInfo; var ABytes: TBytes);
var LStream : TStream;
LTmp : TBytes;
begin
@@ -937,36 +1002,46 @@ procedure TPCAbstractMemListAccountNames.SaveTo(const AItem: TAccountNameInfo; A
End;
end;
-procedure TPCAbstractMemListAccountNames.Add(const AName: String; AAccountNumber: Cardinal);
-var LItem : TAccountNameInfo;
- i : Integer;
+procedure TPCAbstractMemListAccountNames.AddNameAndNumber(const AName: String; AAccountNumber: Cardinal);
+var Lani : TAccountNameInfo;
+ Lposition : TAbstractMemPosition;
begin
- LItem.accountName := AName;
- LItem.accountNumber := AAccountNumber;
- i := inherited Add(LItem);
- if (i<0) then begin
- i := IndexOf(AName);
- if (i<0) then
+ Lani.accountName := AName;
+ Lani.accountNumber := AAccountNumber;
+ if Not AddData(Lani) then begin
+ if Not FindDataPos(Lani,Lposition) then
raise EPCAbstractMem.Create(Format('Fatal error Cannot add account(%d) name %s',[AAccountNumber,AName]))
else raise EPCAbstractMem.Create(Format('Cannot add account(%d) name %s because used by %d with %s',[AAccountNumber,AName,
- GetItem(i).accountNumber,GetItem(i).accountName]));
+ Lani.accountNumber,Lani.accountName]));
end;
end;
-function TPCAbstractMemListAccountNames.Compare(const ALeft, ARight: TAccountNameInfo): integer;
-Var LBytesLeft,LBytesRight : TBytes;
+function TPCAbstractMemListAccountNames.FindByName(const AName: String): Boolean;
+var Lpos : TAbstractMemPosition;
begin
- LBytesLeft.FromString(ALeft.accountName);
- LBytesRight.FromString(ARight.accountName);
- Result := TBaseType.BinStrComp(LBytesLeft,LBytesRight);
+ Result := FindByName(AName,Lpos);
end;
-function TPCAbstractMemListAccountNames.FindByName(const AName: String; out AIndex: Integer): Boolean;
-var LFind : TAccountNameInfo;
+function TPCAbstractMemListAccountNames.FindByName(const AName: String; out ANameInfo: TAccountNameInfo): Boolean;
+var Lpos : TAbstractMemPosition;
begin
- LFind.accountName := AName;
- LFind.accountNumber := 0;
- Result := Find(LFind,AIndex);
+ if FindByName(AName,Lpos) then begin
+ ANameInfo := LoadData(Lpos);
+ Result := True;
+ end else begin
+ if Lpos<>0 then begin
+ ANameInfo := LoadData(Lpos);
+ end;
+ Result := False;
+ end;
+end;
+
+function TPCAbstractMemListAccountNames.FindByName(const AName: String; out AAbstractMemPosition: TAbstractMemPosition): Boolean;
+var Lani : TAccountNameInfo;
+begin
+ Lani.accountName := AName;
+ Lani.accountNumber := 0;
+ Result := FindDataPos(Lani,AAbstractMemPosition);
end;
{ TPCAbstractMemListBlocks }
@@ -976,6 +1051,7 @@ procedure TPCAbstractMemListBlocks.LoadFrom(const ABytes: TBytes; var AItem: TOp
LPointer: TAbstractMemPosition;
LIndex: integer;
begin
+ LPointer := 0;
AItem.accumulatedWork := 0;
Move(ABytes[0], AItem.operationBlock.block, 4);
Move(ABytes[4], LPointer, 4);
@@ -1048,15 +1124,18 @@ procedure TPCAbstractMemCheckThread.BCExecute;
inc(FErrorsCount);
TLog.NewLog(ltError,ClassName,'CheckConsistency: '+AError);
end;
-var iBlock, i, iAccName : Integer;
+var iBlock, i : Integer;
LAccount : TAccount;
LBlockAccount : TBlockAccount;
+ LHighestOperationBlock : TOperationBlockExt;
LOrdered : TOrderedList;
LOrderedNames : TOrderedList;
- LAccountNameInfo : TAccountNameInfo;
LTC, LTCInitial : TTickCount;
LAggregatedHashrate, LBlockHashRate : TBigNum;
+ LBuff1,LBuff2 : TRawBytes;
+ Laninfo : TAccountNameInfo;
begin
+ LBlockAccount := CT_BlockAccount_NUL;
iBlock :=0;
LOrdered := TOrderedList.Create(False,TComparison_Integer);
LOrderedNames := TOrderedList.Create(False,TComparison_String);
@@ -1064,6 +1143,7 @@ procedure TPCAbstractMemCheckThread.BCExecute;
Try
LTC := TPlatform.GetTickCount;
LTCInitial := LTC;
+ LHighestOperationBlock := FPCAbstractMem.GetBlockInfo(FPCAbstractMem.BlocksCount-1);
while (iBlock < FPCAbstractMem.BlocksCount) and (Not Terminated) do begin
if FMustRestart then begin
TLog.NewLog(ltdebug,ClassName,Format('Restarting check thread after %d/%d blocks',[iBlock+1,FPCAbstractMem.BlocksCount]) );
@@ -1074,6 +1154,7 @@ procedure TPCAbstractMemCheckThread.BCExecute;
LOrdered.Clear;
LOrderedNames.Clear;
LAggregatedHashrate.Value := 0;
+ LHighestOperationBlock := FPCAbstractMem.GetBlockInfo(FPCAbstractMem.BlocksCount-1);
end;
LBlockAccount := FPCAbstractMem.GetBlockAccount(iBlock);
@@ -1084,19 +1165,30 @@ procedure TPCAbstractMemCheckThread.BCExecute;
if LOrderedNames.Add(LAccount.name.ToString)<0 then begin
_error(Format('Account %d name %s allready added',[LAccount.account,LAccount.name.ToString]));
end;
- iAccName := FPCAbstractMem.AccountsNames.IndexOf(LAccount.name.ToString);
- if iAccName<0 then begin
+ if Not FPCAbstractMem.AccountsNames.FindByName(LAccount.name.ToString,Laninfo) then begin
// ERROR
_error(Format('Account %d name %s not found at list',[LAccount.account,LAccount.name.ToString]));
end else begin
- if FPCAbstractMem.AccountsNames.Item[iAccName].accountNumber<>LAccount.account then begin
- _error(Format('Account %d name %s found at list at pos %d but links to %d',[LAccount.account,LAccount.name.ToString,iAccName,FPCAbstractMem.AccountsNames.Item[iAccName].accountNumber]));
+ if Laninfo.accountNumber<>LAccount.account then begin
+ _error(Format('Account %d name %s found at list but links to %d',[LAccount.account,LAccount.name.ToString,Laninfo.accountNumber]));
end;
if (LOrdered.Add(LAccount.account)<0) then begin
_error(Format('Account %d (with name %s) allready added',[LAccount.account,LAccount.name.ToString]));
end;
end;
end;
+ if LAccount.GetLastUpdatedBlock>=FPCAbstractMem.BlocksCount then begin
+ _error(Format('Account Updated %d > %d - %s',[LAccount.GetLastUpdatedBlock,FPCAbstractMem.BlocksCount,TAccountComp.AccountToTxt(LAccount)]));
+ end;
+
+ end;
+ LBuff1 := TPCSafeBox.CalcBlockHash(LBlockAccount,LHighestOperationBlock.operationBlock.protocol_version);
+ If Not (LBuff1.IsEqualTo(LBlockAccount.block_hash)) then begin
+ _error(Format('Blockaccount hash for %d are not equals: calculated %s <> saved %s',[LBlockAccount.blockchainInfo.block,LBuff1.ToHexaString,LBlockAccount.block_hash.ToHexaString]));
+ end;
+ LBuff2 := FPCAbstractMem.FBufferBlocksHash.Capture((iBlock*32),32);
+ if Not LBuff1.IsEqualTo(LBuff2) then begin
+ _error(Format('Blockaccount hash for %d are not equals: %s <> %s',[LBlockAccount.blockchainInfo.block,LBuff1.ToHexaString,LBuff2.ToHexaString]));
end;
LBlockHashRate := TBigNum.TargetToHashRate( LBlockAccount.blockchainInfo.compact_target );
@@ -1113,12 +1205,21 @@ procedure TPCAbstractMemCheckThread.BCExecute;
inc(iBlock);
end;
//
- for i := 0 to FPCAbstractMem.AccountsNames.Count-1 do begin
- LAccountNameInfo := FPCAbstractMem.AccountsNames.Item[i];
- if LOrdered.IndexOf( LAccountNameInfo.accountNumber ) < 0 then begin
- _error(Format('Account name %s at index %d/%d not found in search',[LAccountNameInfo.accountName, i+1,FPCAbstractMem.AccountsNames.Count]));
- end;
+ FPCAbstractMem.FBufferBlocksHash.SafeBoxHashCalcType := sbh_Single_Sha256;
+ FPCAbstractMem.FBufferBlocksHash.SafeBoxHashCalcType := sbh_Merkle_Root_Hash;
+ LBuff1 := FPCAbstractMem.FBufferBlocksHash.GetSafeBoxHash;
+ FErrors.Add(Format('Last Block %d - SBH %s - Next SBH: %s',[LBlockAccount.blockchainInfo.block,LBlockAccount.blockchainInfo.initial_safe_box_hash.ToHexaString,LBuff1.ToHexaString]));
+ //
+ i := 0;
+ if FPCAbstractMem.AccountsNames.FindDataLowest(Laninfo) then begin
+ repeat
+ inc(i);
+ if LOrdered.IndexOf(Laninfo.accountNumber ) < 0 then begin
+ _error(Format('Account name %s at index %d/%d not found in search',[Laninfo.accountName, i,FPCAbstractMem.AccountsNames.Count]));
+ end;
+ until Not FPCAbstractMem.AccountsNames.FindDataSuccessor(Laninfo,Laninfo);
end;
+
if (LOrdered.Count)<>FPCAbstractMem.AccountsNames.Count then begin
_error(Format('Found %d accounts with names but %d on list',[LOrdered.Count,FPCAbstractMem.AccountsNames.Count]));
end;
@@ -1168,6 +1269,7 @@ destructor TPCAbstractMemCheckThread.Destroy;
FPCAbstractMem.FLockAbstractMem.Release;
end;
FErrors.Free;
+ inherited Destroy;
end;
procedure TPCAbstractMemCheckThread.Restart;
@@ -1177,4 +1279,17 @@ procedure TPCAbstractMemCheckThread.Restart;
end;
+{ TPCAbstractMemStats }
+
+procedure TPCAbstractMemStats.Clear;
+begin
+ Self.FlushesCount := 0;
+ Self.FlushesMillis := 0;
+end;
+
+function TPCAbstractMemStats.ToString: String;
+begin
+ Result := Format('PCAbstractMem flushes:%d in %d millis',[Self.FlushesCount,Self.FlushesMillis]);
+end;
+
end.
diff --git a/src/core/UPCAbstractMemAccountKeys.pas b/src/core/UPCAbstractMemAccountKeys.pas
index a16cf294e..19f185906 100644
--- a/src/core/UPCAbstractMemAccountKeys.pas
+++ b/src/core/UPCAbstractMemAccountKeys.pas
@@ -9,8 +9,8 @@ interface
uses Classes, SysUtils,
SyncObjs,
UAbstractMem, UFileMem, UAbstractMemTList,
- UAbstractBTree,
- UPCDataTypes, UBaseTypes, UAVLCache,
+ UAbstractBTree, UAbstractAVLTree,
+ UPCDataTypes, UBaseTypes, UAVLCache, UAbstractMemBTree, UOrderedList,
{$IFNDEF FPC}System.Generics.Collections,System.Generics.Defaults{$ELSE}Generics.Collections,Generics.Defaults{$ENDIF};
type
@@ -20,7 +20,7 @@ TAbstractMemAccountKeyNode = record
myPosition : TAbstractMemPosition; // Position in the AbstractMem
accountKey : TAccountKey;
accounts_using_this_key_position : TAbstractMemPosition;
- function GetSize : Integer;
+ function GetSize(AAbstractMem : TAbstractMem) : Integer;
procedure ReadFromMem(AMyPosition : TAbstractMemPosition; AAbstractMem : TAbstractMem);
procedure WriteToMem(AAbstractMem : TAbstractMem);
procedure Clear;
@@ -31,16 +31,16 @@ TAbstractMemAccountKeyNode = record
{ TAccountsUsingThisKey }
- TAccountsUsingThisKey = Class(TAbstractMemOrderedTList)
+ TAccountsUsingThisKey = Class(TAbstractMemBTree)
+ // AbstractMem position will be considered a Account Number
protected
- function GetItem(index : Integer) : Cardinal; override;
- procedure LoadFrom(const ABytes : TBytes; var AItem : Cardinal); override;
- procedure SaveTo(const AItem : Cardinal; AIsAddingItem : Boolean; var ABytes : TBytes); override;
- function Compare(const ALeft, ARight : Cardinal) : Integer; override;
+ procedure DisposeData(var AData : TAbstractMemPosition); override;
+ function DoCompareData(const ALeftData, ARightData: TAbstractMemPosition): Integer; override;
public
- Constructor Create(AAbstractMem : TAbstractMem; const AInitialZone : TAMZone); reintroduce;
- Function Add(const AItem : Cardinal) : Integer; reintroduce;
- procedure Delete(index : Integer); reintroduce;
+ function NodeDataToString(const AData : TAbstractMemPosition) : String; override;
+ public
+ Constructor Create(AAbstractMem : TAbstractMem; const AInitialZone : TAMZone; AUseCache : Boolean); reintroduce;
+ function Get(Index : Integer) : Cardinal;
End;
TAccountKeyByPosition = record
@@ -64,6 +64,7 @@ TAccountKeyByPosition = record
FPointerToRootPosition : TAbstractMemPosition;
FRootPosition : TAbstractMemPosition;
FAccountKeyByPositionCache : TPCAccountKeyByPositionCache;
+ FUseCacheOnAbstractMemLists: Boolean;
protected
function GetRoot: TAbstractMemAccountKeyNode; override;
procedure SetRoot(const Value: TAbstractMemAccountKeyNode); override;
@@ -79,7 +80,7 @@ TAccountKeyByPosition = record
public
function IsNil(const ANode : TAbstractMemAccountKeyNode) : Boolean; override;
function ToString(const ANode: TAbstractMemAccountKeyNode) : String; override;
- constructor Create(AAbstractMem : TAbstractMem; APointerToRootPosition : TAbstractMemPosition); reintroduce;
+ constructor Create(AAbstractMem : TAbstractMem; APointerToRootPosition : TAbstractMemPosition; AUseCacheOnAbstractMemLists : Boolean); reintroduce;
destructor Destroy; override;
//
function GetKeyAtPosition(APosition : TAbstractMemPosition) : TAccountKey;
@@ -89,6 +90,8 @@ TAccountKeyByPosition = record
procedure GetAccountsUsingKey(const AAccountKey : TAccountKey; const AList : TList);
function GetAccountsUsingThisKey(const AAccountKey : TAccountKey) : TAccountsUsingThisKey;
procedure FlushCache;
+ property UseCacheOnAbstractMemLists : Boolean read FUseCacheOnAbstractMemLists write FUseCacheOnAbstractMemLists;
+ property AccountKeyByPositionCache : TPCAccountKeyByPositionCache read FAccountKeyByPositionCache;
end;
@@ -113,7 +116,7 @@ class function TAccountsUsingThisKey_BlackHole.GetInstance: TAccountsUsingThisKe
_BlackHoleAbstractMem := TMem.Create(0,True);
end;
LZone.Clear;
- _TAccountsUsingThisKey_BlackHole := TAccountsUsingThisKey_BlackHole.Create(_BlackHoleAbstractMem,LZone);
+ _TAccountsUsingThisKey_BlackHole := TAccountsUsingThisKey_BlackHole.Create(_BlackHoleAbstractMem,LZone,True);
end;
Result := _TAccountsUsingThisKey_BlackHole;
end;
@@ -130,9 +133,9 @@ procedure TAbstractMemAccountKeyNode.Clear;
Self.accounts_using_this_key_position := 0;
end;
-function TAbstractMemAccountKeyNode.GetSize: Integer;
+function TAbstractMemAccountKeyNode.GetSize(AAbstractMem : TAbstractMem) : Integer;
begin
- Result := accountKey.GetSerializedLength + 4 + TAbstractMemAVLTreeNodeInfoClass.GetSize;
+ Result := accountKey.GetSerializedLength + 4 + TAbstractMemAVLTreeNodeInfoClass.GetSize(AAbstractMem);
end;
procedure TAbstractMemAccountKeyNode.ReadFromMem(AMyPosition: TAbstractMemPosition; AAbstractMem: TAbstractMem);
@@ -142,7 +145,7 @@ procedure TAbstractMemAccountKeyNode.ReadFromMem(AMyPosition: TAbstractMemPositi
begin
Self.Clear;
Self.myPosition := AMyPosition;
- inc(AMyPosition,TAbstractMemAVLTreeNodeInfoClass.GetSize);
+ inc(AMyPosition,TAbstractMemAVLTreeNodeInfoClass.GetSize(AAbstractMem));
// Minimum size is 4 + 2 + 2 = 8 bytes
i := 8;
SetLength(LBytes,i);
@@ -177,7 +180,7 @@ procedure TAbstractMemAccountKeyNode.WriteToMem(AAbstractMem: TAbstractMem);
LStream.Write(Self.accounts_using_this_key_position,4);
Self.accountKey.ToSerialized(LStream);
LBytes.FromStream(LStream);
- AAbstractMem.Write(Self.myPosition + TAbstractMemAVLTreeNodeInfoClass.GetSize,LBytes[0],Length(LBytes));
+ AAbstractMem.Write(Self.myPosition + TAbstractMemAVLTreeNodeInfoClass.GetSize(AAbstractMem),LBytes[0],Length(LBytes));
finally
LStream.Free;
end;
@@ -225,12 +228,13 @@ function _AccountKeyByPositionCache_Comparision(const Left, Right: TPCAccountKey
Result := Left.data.position - Right.data.position;
end;
-constructor TPCAbstractMemAccountKeys.Create(AAbstractMem: TAbstractMem; APointerToRootPosition : TAbstractMemPosition);
+constructor TPCAbstractMemAccountKeys.Create(AAbstractMem: TAbstractMem; APointerToRootPosition : TAbstractMemPosition; AUseCacheOnAbstractMemLists : Boolean);
begin
FAccountKeysLock := TCriticalSection.Create;
FAbstractMem := AAbstractMem;
FPointerToRootPosition := APointerToRootPosition;
FRootPosition := 0;
+ FUseCacheOnAbstractMemLists := AUseCacheOnAbstractMemLists;
// Read Root position
FAbstractMem.Read(FPointerToRootPosition,FRootPosition,4);
FAccountKeyByPositionCache := TPCAccountKeyByPositionCache.Create(5000,_AccountKeyByPositionCache_Comparision);
@@ -239,8 +243,8 @@ constructor TPCAbstractMemAccountKeys.Create(AAbstractMem: TAbstractMem; APointe
destructor TPCAbstractMemAccountKeys.Destroy;
begin
- FAccountKeyByPositionCache.Free;
- FAccountKeysLock.Free;
+ FreeAndNil(FAccountKeyByPositionCache);
+ FreeAndNil(FAccountKeysLock);
inherited;
end;
@@ -258,15 +262,17 @@ procedure TPCAbstractMemAccountKeys.FlushCache;
procedure TPCAbstractMemAccountKeys.GetAccountsUsingKey(
const AAccountKey: TAccountKey; const AList: TList);
var Lautk : TAccountsUsingThisKey;
- i : Integer;
+ i : TAbstractMemPosition;
begin
AList.Clear;
FAccountKeysLock.Acquire;
try
Lautk := GetAccountsUsingThisKey(AAccountKey);
if Assigned(Lautk) then begin
- for i:=0 to Lautk.Count-1 do begin
- AList.Add( Lautk.GetItem(i) );
+ if Lautk.FindLowest(i) then begin
+ repeat
+ AList.Add(i);
+ until Not Lautk.FindSuccessor(i,i);
end;
end;
finally
@@ -297,7 +303,7 @@ function TPCAbstractMemAccountKeys.GetAccountsUsingThisKey(const AAccountKey: TA
LP.Clear;
LP.position := LNode.myPosition;
LP.accountKey := AAccountKey;
- LP.accountsUsingThisKey := TAccountsUsingThisKey.Create(FAbstractMem,LZone);
+ LP.accountsUsingThisKey := TAccountsUsingThisKey.Create(FAbstractMem,LZone,Self.UseCacheOnAbstractMemLists);
FAccountKeyByPositionCache.Add(LP); // Add to cache!
end;
Result := LP.accountsUsingThisKey;
@@ -330,7 +336,7 @@ function TPCAbstractMemAccountKeys.GetKeyAtPosition(APosition: TAbstractMemPosit
if LNode.accounts_using_this_key_position>0 then begin
LAccZone.Clear;
LAccZone.position := LNode.accounts_using_this_key_position;
- LP.accountsUsingThisKey := TAccountsUsingThisKey.Create(FAbstractMem,LAccZone);
+ LP.accountsUsingThisKey := TAccountsUsingThisKey.Create(FAbstractMem,LAccZone,Self.UseCacheOnAbstractMemLists);
end else LP.accountsUsingThisKey := Nil;
FAccountKeyByPositionCache.Add(LP); // Add to cache!
end;
@@ -367,7 +373,7 @@ function TPCAbstractMemAccountKeys.GetPositionOfKeyAndAddAccount(const AAccountK
// if LNode does not exists, then ADD
LNode.accountKey := AAccountKey;
LNode.accounts_using_this_key_position := 0;
- LNode.myPosition := FAbstractMem.New( LNode.GetSize ).position;
+ LNode.myPosition := FAbstractMem.New( LNode.GetSize(FAbstractMem) ).position;
LNode.WriteToMem(FAbstractMem);
Add(LNode);
end;
@@ -388,11 +394,11 @@ function TPCAbstractMemAccountKeys.GetPositionOfKeyAndAddAccount(const AAccountK
LZone.Clear;
if (LNode.accounts_using_this_key_position=0) then begin
// Create
- LZone := FAbstractMem.New( CT_AbstractMemTList_HeaderSize );
+ LZone := FAbstractMem.New( TAbstractMemTList.MinAbstractMemTListHeaderSize(FAbstractMem) );
LNode.accounts_using_this_key_position := LZone.position;
LNode.WriteToMem( FAbstractMem ); // Save update:
end else LZone.position := LNode.accounts_using_this_key_position;
- LAccKeyByPos.accountsUsingThisKey := TAccountsUsingThisKey.Create(FAbstractMem,LZone);
+ LAccKeyByPos.accountsUsingThisKey := TAccountsUsingThisKey.Create(FAbstractMem,LZone,Self.UseCacheOnAbstractMemLists);
// Add to cache
FAccountKeyByPositionCache.Add( LAccKeyByPos );
end;
@@ -410,7 +416,6 @@ function TPCAbstractMemAccountKeys.GetPositionOfKeyAndRemoveAccount(
const AAccountNumber: Cardinal): TAbstractMemPosition;
var LNode : TAbstractMemAccountKeyNode;
LZone : TAMZone;
- i : Integer;
Lacckutk : TAccountsUsingThisKey;
LAccKeyByPos : TAccountKeyByPosition;
begin
@@ -435,16 +440,13 @@ function TPCAbstractMemAccountKeys.GetPositionOfKeyAndRemoveAccount(
LAccKeyByPos.accountKey := AAccountKey;
LZone.Clear;
LZone.position := LNode.accounts_using_this_key_position;
- LAccKeyByPos.accountsUsingThisKey := TAccountsUsingThisKey.Create(FAbstractMem,LZone);
+ LAccKeyByPos.accountsUsingThisKey := TAccountsUsingThisKey.Create(FAbstractMem,LZone,Self.UseCacheOnAbstractMemLists);
// Add to cache
FAccountKeyByPositionCache.Add( LAccKeyByPos );
end;
if Assigned(LAccKeyByPos.accountsUsingThisKey) then begin
- i := LAccKeyByPos.accountsUsingThisKey.IndexOf( AAccountNumber );
- if i>=0 then begin
- LAccKeyByPos.accountsUsingThisKey.Delete( i );
- end;
+ LAccKeyByPos.accountsUsingThisKey.Delete( AAccountNumber );
end;
finally
FAccountKeysLock.Release;
@@ -461,7 +463,7 @@ function TPCAbstractMemAccountKeys.GetPositionOfKey(const AAccountKey: TAccountK
// if LNode does not exists, then ADD
LNode.accountKey := AAccountKey;
LNode.accounts_using_this_key_position := 0;
- LNode.myPosition := FAbstractMem.New( LNode.GetSize ).position;
+ LNode.myPosition := FAbstractMem.New( LNode.GetSize(FAbstractMem) ).position;
LNode.WriteToMem(FAbstractMem);
Add(LNode);
end;
@@ -520,53 +522,32 @@ function TPCAbstractMemAccountKeys.ToString(const ANode: TAbstractMemAccountKeyN
{ TAccountsUsingThisKey }
-procedure TAccountsUsingThisKey.LoadFrom(const ABytes: TBytes; var AItem: Cardinal);
-begin
- Move(ABytes[0],AItem,4);
-end;
-
-procedure TAccountsUsingThisKey.SaveTo(const AItem: Cardinal; AIsAddingItem : Boolean; var ABytes: TBytes);
+constructor TAccountsUsingThisKey.Create(AAbstractMem: TAbstractMem; const AInitialZone: TAMZone; AUseCache : Boolean);
begin
- SetLength(ABytes,4);
- Move(AItem,ABytes[0],4);
- raise Exception.Create('INCONSISTENT 20200324-1 NEVER CALL HERE');
+ inherited Create(AAbstractMem,AInitialZone,False, 7);
end;
-function TAccountsUsingThisKey.Add(const AItem: Cardinal): Integer;
-var
- LFound : Boolean;
- LBytes : TBytes;
- LZone : TAMZone;
-begin
- FList.LockList;
- try
- LFound := Find(AItem,Result);
- if (LFound and AllowDuplicates) or (Not LFound) then begin
- FList.Insert( Result , AItem );
- end else Result := -1;
- finally
- FList.UnlockList;
- end;
-end;
-function TAccountsUsingThisKey.Compare(const ALeft, ARight: Cardinal): Integer;
+procedure TAccountsUsingThisKey.DisposeData(var AData: TAbstractMemPosition);
begin
- Result := ALeft - ARight;
+ // NOTE: Nothing to do NEITHER to inherit from ancestor
end;
-constructor TAccountsUsingThisKey.Create(AAbstractMem: TAbstractMem; const AInitialZone: TAMZone);
+function TAccountsUsingThisKey.DoCompareData(const ALeftData, ARightData: TAbstractMemPosition): Integer;
begin
- inherited Create(AAbstractMem,AInitialZone,1000,False);
+ Result := ALeftData - ARightData;
end;
-procedure TAccountsUsingThisKey.Delete(index: Integer);
+function TAccountsUsingThisKey.Get(Index: Integer): Cardinal;
+var i : TAbstractMemPosition;
begin
- FList.Delete( index );
+ if Not FindIndex(Index,i) then raise Exception.Create(Format('Accounts using this key index %d not found',[Index]));
+ Result := i;
end;
-function TAccountsUsingThisKey.GetItem(index: Integer): Cardinal;
+function TAccountsUsingThisKey.NodeDataToString(const AData: TAbstractMemPosition): String;
begin
- Result := FList.Position[index];
+ Result := IntToStr(AData);
end;
{ TPCAccountKeyByPositionCache }
diff --git a/src/core/UPCAbstractMemAccounts.pas b/src/core/UPCAbstractMemAccounts.pas
new file mode 100644
index 000000000..b42fc6551
--- /dev/null
+++ b/src/core/UPCAbstractMemAccounts.pas
@@ -0,0 +1,214 @@
+unit UPCAbstractMemAccounts;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+
+uses Classes, SysUtils, SyncObjs,
+ UPCAbstractMemAccountKeys, UPCAccountsOrdenations,
+ UAbstractMem,
+ UAbstractMemTList,
+ UPCDataTypes,
+ UBaseTypes,
+ UConst,
+ {$IFNDEF FPC}System.Generics.Collections,System.Generics.Defaults{$ELSE}Generics.Collections,Generics.Defaults{$ENDIF};
+
+type
+ { TPCAbstractMemListAccounts }
+
+ TPCAbstractMemListAccounts = class(TAbstractMemTList)
+ private
+ FAccountKeys: TPCAbstractMemAccountKeys;
+ FAccountsOrderedByUpdatedBlock : TAccountsOrderedByUpdatedBlock;
+ FAccountsOrderedBySalePrice : TAccountsOrderedBySalePrice;
+ protected
+ procedure LoadFrom(const ABytes: TBytes; var AItem: TAccount); override;
+ procedure SaveTo(const AItem: TAccount; AIsAddingItem : Boolean; var ABytes: TBytes); override;
+ public
+ Constructor Create(AAbstractMem : TAbstractMem; const AInitialZone : TAMZone; ADefaultElementsPerBlock : Integer; AUseCache : Boolean); override;
+ class procedure LoadAccountFromTBytes(const ABytes: TBytes; const AAccountKeys : TPCAbstractMemAccountKeys; var AItem: TAccount);
+ property AccountKeys: TPCAbstractMemAccountKeys read FAccountKeys write FAccountKeys;
+ property AccountsOrderedByUpdatedBlock: TAccountsOrderedByUpdatedBlock read FAccountsOrderedByUpdatedBlock write FAccountsOrderedByUpdatedBlock;
+ property AccountsOrderedBySalePrice: TAccountsOrderedBySalePrice read FAccountsOrderedBySalePrice write FAccountsOrderedBySalePrice;
+ end;
+
+ EAbsctractMemAccounts = Class(Exception);
+
+implementation
+
+uses UAccounts, UOrderedList;
+
+{ TPCAbstractMemListAccounts }
+
+constructor TPCAbstractMemListAccounts.Create(AAbstractMem: TAbstractMem;
+ const AInitialZone: TAMZone; ADefaultElementsPerBlock: Integer;
+ AUseCache: Boolean);
+begin
+ inherited;
+ FAccountKeys := Nil;
+ FAccountsOrderedByUpdatedBlock := Nil;
+ FAccountsOrderedBySalePrice := Nil;
+end;
+
+class procedure TPCAbstractMemListAccounts.LoadAccountFromTBytes(
+ const ABytes: TBytes; const AAccountKeys: TPCAbstractMemAccountKeys;
+ var AItem: TAccount);
+var
+ LPointer: TAbstractMemPosition;
+ LStream : TStream;
+ w : Word;
+begin
+ AItem.Clear;
+ LStream := TMemoryStream.Create;
+ Try
+ LPointer := 0;
+ LStream.Write(ABytes[0],Length(ABytes));
+ LStream.Position := 0;
+
+ LStream.Read( AItem.account , 4 );
+
+ LStream.Read( w,2 );
+ if (w<>CT_PROTOCOL_5) then raise EAbsctractMemAccounts.Create(Format('Invalid Account %d protocol %d',[AItem.account,w]));
+
+ LStream.Read( w, 2 );
+ case w of
+ CT_NID_secp256k1,CT_NID_secp384r1,CT_NID_sect283k1,CT_NID_secp521r1 : Begin
+ AItem.accountInfo.state := as_Normal;
+ LStream.Read(LPointer,4);
+ if Assigned(AAccountKeys) then begin
+ AItem.accountInfo.accountKey := AAccountKeys.GetKeyAtPosition( LPointer );
+ if w<>AItem.accountInfo.accountKey.EC_OpenSSL_NID then raise EAbsctractMemAccounts.Create('INCONSISTENT 20200318-2');
+ end;
+ End;
+ CT_AccountInfo_ForSale, CT_AccountInfo_ForAccountSwap, CT_AccountInfo_ForCoinSwap : Begin
+ case w of
+ CT_AccountInfo_ForSale : AItem.accountInfo.state := as_ForSale;
+ CT_AccountInfo_ForAccountSwap : AItem.accountInfo.state := as_ForAtomicAccountSwap;
+ CT_AccountInfo_ForCoinSwap : AItem.accountInfo.state := as_ForAtomicCoinSwap;
+ end;
+ LStream.Read(LPointer,4);
+ if Assigned(AAccountKeys) then begin
+ AItem.accountInfo.accountKey := AAccountKeys.GetKeyAtPosition( LPointer );
+ end;
+
+ LStream.Read(AItem.accountInfo.locked_until_block,4);
+ LStream.Read(AItem.accountInfo.price,8);
+ LStream.Read(AItem.accountInfo.account_to_pay,4);
+ LStream.Read(LPointer,4);
+ if Assigned(AAccountKeys) then begin
+ AItem.accountInfo.new_publicKey := AAccountKeys.GetKeyAtPosition( LPointer );
+ end;
+ if (w<>CT_AccountInfo_ForSale) then begin
+ AItem.accountInfo.hashed_secret.FromSerialized(LStream);
+ end;
+
+ End;
+ else raise EAbsctractMemAccounts.Create(Format('Unknow accountInfo type %d for account %d',[w,Aitem.account]));
+ end;
+ //
+ LStream.Read( AItem.balance , 8);
+ LStream.Read( AItem.updated_on_block_passive_mode , 4);
+ LStream.Read( AItem.updated_on_block_active_mode , 4);
+ LStream.Read( AItem.n_operation , 4);
+ AItem.name.FromSerialized( LStream );
+ LStream.Read( AItem.account_type ,2);
+ AItem.account_data.FromSerialized( LStream );
+ if AItem.account_seal.FromSerialized( LStream )<0 then raise EAbsctractMemAccounts.Create('INCONSISTENT 20200318-4');
+ // Force account_seal to 20 bytes
+ if Length(AItem.account_seal)<>20 then begin
+ AItem.account_seal := TBaseType.T20BytesToRawBytes( TBaseType.To20Bytes(AItem.account_seal) );
+ end;
+ Finally
+ LStream.Free;
+ End;
+end;
+
+procedure TPCAbstractMemListAccounts.LoadFrom(const ABytes: TBytes; var AItem: TAccount);
+begin
+ LoadAccountFromTBytes(ABytes,FAccountKeys,AItem);
+end;
+
+procedure TPCAbstractMemListAccounts.SaveTo(const AItem: TAccount; AIsAddingItem : Boolean; var ABytes: TBytes);
+var LStream : TStream;
+ LPointer : TAbstractMemPosition;
+ w : Word;
+ LPrevious : TAccount;
+begin
+ if (Length(ABytes)>0) and (Not AIsAddingItem) then begin
+ // Capture previous values
+ LoadFrom(ABytes,LPrevious);
+ if (LPrevious.account<>AItem.account) then raise EAbsctractMemAccounts.Create(Format('INCONSISTENT account number %d<>%d',[AItem.account,LPrevious.account]));
+
+ if Not LPrevious.accountInfo.accountKey.IsEqualTo( AItem.accountInfo.accountKey ) then begin
+ // Remove previous account link
+ FAccountKeys.GetPositionOfKeyAndRemoveAccount( LPrevious.accountInfo.accountKey, LPrevious.account );
+ end;
+
+ if LPrevious.updated_on_block_active_mode<>AItem.updated_on_block_active_mode then begin
+ FAccountsOrderedByUpdatedBlock.Update(AItem.account,LPrevious.updated_on_block_active_mode,AItem.updated_on_block_active_mode);
+ end;
+ FAccountsOrderedBySalePrice.UpdateAccountBySalePrice(AItem.account,LPrevious.accountInfo,AItem.accountInfo);
+ end else begin
+ FAccountsOrderedByUpdatedBlock.Update(AItem.account,0,AItem.updated_on_block_active_mode);
+ FAccountsOrderedBySalePrice.UpdateAccountBySalePrice(AItem.account,CT_AccountInfo_NUL,AItem.accountInfo);
+ end;
+
+ LStream := TMemoryStream.Create;
+ try
+ LStream.Position := 0;
+
+
+ LStream.Write( AItem.account , 4 );
+
+ w := CT_PROTOCOL_5;
+ LStream.Write( w, 2 );
+
+ w := 0;
+ case AItem.accountInfo.state of
+ as_Normal : begin
+ LPointer := FAccountKeys.GetPositionOfKeyAndAddAccount(AItem.accountInfo.accountKey,AItem.account);
+ LStream.Write( AItem.accountInfo.accountKey.EC_OpenSSL_NID , 2 );
+ LStream.Write( LPointer, 4);
+ end;
+ as_ForSale : w := CT_AccountInfo_ForSale;
+ as_ForAtomicAccountSwap : w := CT_AccountInfo_ForAccountSwap;
+ as_ForAtomicCoinSwap : w := CT_AccountInfo_ForCoinSwap;
+ end;
+ if (w>0) then begin
+ LStream.Write(w,2);
+
+ LPointer := FAccountKeys.GetPositionOfKeyAndAddAccount(AItem.accountInfo.accountKey,AItem.account);
+ LStream.Write( LPointer, 4);
+
+ LStream.Write(AItem.accountInfo.locked_until_block,4);
+ LStream.Write(AItem.accountInfo.price,8);
+ LStream.Write(AItem.accountInfo.account_to_pay,4);
+ LPointer := FAccountKeys.GetPositionOfKey(AItem.accountInfo.new_publicKey,True);
+ LStream.Write(LPointer,4);
+ if (w<>CT_AccountInfo_ForSale) then begin
+ AItem.accountInfo.hashed_secret.ToSerialized(LStream);
+ end;
+ end;
+ //
+ LStream.Write( AItem.balance , 8);
+ LStream.Write( AItem.updated_on_block_passive_mode , 4);
+ LStream.Write( AItem.updated_on_block_active_mode , 4);
+ LStream.Write( AItem.n_operation , 4);
+
+ AItem.name.ToSerialized( LStream );
+
+ LStream.Write( AItem.account_type ,2);
+ AItem.account_data.ToSerialized( LStream );
+ AItem.account_seal.ToSerialized( LStream );
+ //
+ ABytes.FromStream( LStream );
+
+ finally
+ LStream.Free;
+ end;
+end;
+
+
+end.
diff --git a/src/core/UPCAccountsOrdenations.pas b/src/core/UPCAccountsOrdenations.pas
new file mode 100644
index 000000000..66d54ad1d
--- /dev/null
+++ b/src/core/UPCAccountsOrdenations.pas
@@ -0,0 +1,251 @@
+unit UPCAccountsOrdenations;
+
+{ Copyright (c) 2016-2021 by Albert Molina
+
+ Distributed under the MIT software license, see the accompanying file LICENSE
+ or visit http://www.opensource.org/licenses/mit-license.php.
+
+ This unit is a part of the PascalCoin Project, an infinitely scalable
+ cryptocurrency. Find us here:
+ Web: https://www.pascalcoin.org
+ Source: https://github.com/PascalCoin/PascalCoin
+
+ If you like it, consider a donation using Bitcoin:
+ 16K3HCZRhFUtM8GdWRcfKeaa6KsuyxZaYk
+
+ THIS LICENSE HEADER MUST NOT BE REMOVED.
+}
+
+interface
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+
+{$I ./../config.inc}
+
+uses Classes, SysUtils,
+ UAbstractMem,
+ UAbstractMemBTree,
+ UAbstractBTree,
+ UPCDataTypes, UBaseTypes, UOrderedList,
+ {$IFNDEF FPC}System.Generics.Collections,System.Generics.Defaults{$ELSE}Generics.Collections,Generics.Defaults{$ENDIF};
+
+type
+
+ TCallReturnAccount = function(AAccountNumber : Integer; var AAccount : TAccount) : Boolean of object;
+
+ TAccountsOrderedByUpdatedBlock = Class
+ private
+ type
+ TAccounstByUpdatedBlockBTree = Class({$IFDEF USE_ABSTRACTMEM}TAbstractMemBTree{$ELSE}TMemoryBTree{$ENDIF})
+ protected
+ FCallReturnAccount : TCallReturnAccount;
+ FSearching_AccountNumber : Int64;
+ FSearching_UpdatedBlock : Integer;
+ function DoCompareData(const ALeftData, ARightData: TAbstractMemPosition): Integer; override;
+ public
+ function NodeDataToString(const AData : TAbstractMemPosition) : String; override;
+ End;
+ private
+ var
+ FBTree : TAccounstByUpdatedBlockBTree;
+ {$IFDEF USE_ABSTRACTMEM}
+ FAbstractMem : TAbstractMem;
+ {$ENDIF}
+ public
+ constructor Create({$IFDEF USE_ABSTRACTMEM}AAbstractMem : TAbstractMem; const AInitialZone : TAMZone; {$ENDIF}ACallReturnAccount : TCallReturnAccount);
+ destructor Destroy; override;
+ function First(var AAccountNumber : Integer) : Boolean;
+ function Next(var AAccountNumber : Integer) : Boolean;
+ function Count : Integer;
+ function Update(const AAccountNumber, AOldUpdatedBlock, ANewUpdatedBlock : Integer) : Boolean;
+ End;
+
+ TAccountsOrderedBySalePrice = Class({$IFDEF USE_ABSTRACTMEM}TAbstractMemBTree{$ELSE}TMemoryBTree{$ENDIF})
+ protected
+ FCallReturnAccount : TCallReturnAccount;
+ FSearching_AccountNumber : Integer;
+ FSearching_AccountInfo : TAccountInfo;
+ function DoCompareData(const ALeftData, ARightData: TAbstractMemPosition): Integer; override;
+ public
+ function NodeDataToString(const AData : TAbstractMemPosition) : String; override;
+ function UpdateAccountBySalePrice(const AAccountNumber : Integer; const AOldAccountInfo, ANewAccountInfo : TAccountInfo) : Boolean;
+ constructor Create({$IFDEF USE_ABSTRACTMEM}AAbstractMem : TAbstractMem; const AInitialZone: TAMZone; {$ENDIF}ACallReturnAccount : TCallReturnAccount);
+ End;
+
+implementation
+
+Uses UPCAbstractMemAccounts, UAccounts;
+
+{ TAccountsOrderedByUpdatedBlock }
+
+function TAccountsOrderedByUpdatedBlock.Count: Integer;
+begin
+ Result := FBTree.Count;
+end;
+
+constructor TAccountsOrderedByUpdatedBlock.Create({$IFDEF USE_ABSTRACTMEM}AAbstractMem : TAbstractMem; const AInitialZone : TAMZone; {$ENDIF}ACallReturnAccount : TCallReturnAccount);
+begin
+ {$IFDEF USE_ABSTRACTMEM}
+ FAbstractMem := AAbstractMem;
+ FBTree := TAccounstByUpdatedBlockBTree.Create(FAbstractMem,AInitialZone,False,31);
+ {$ELSE}
+ FBTree := TAccounstByUpdatedBlockBTree.Create(Nil,False,31);
+ {$ENDIF}
+ FBTree.FSearching_AccountNumber := -1;
+ FBTree.FSearching_UpdatedBlock := 0;
+ FBTree.FCallReturnAccount := ACallReturnAccount;
+end;
+
+destructor TAccountsOrderedByUpdatedBlock.Destroy;
+begin
+ FBTree.Free;
+ inherited;
+end;
+
+function TAccountsOrderedByUpdatedBlock.First(var AAccountNumber : Integer) : Boolean;
+var i : Int64;
+begin
+ FBTree.Lock;
+ Try
+ FBTree.FSearching_AccountNumber := -1;
+ i := AAccountNumber;
+ Result := FBTree.FindLowest(i);
+ AAccountNumber := i;
+ Finally
+ FBTree.Unlock;
+ End;
+end;
+
+function TAccountsOrderedByUpdatedBlock.Next(var AAccountNumber : Integer): Boolean;
+var i : Int64;
+begin
+ FBTree.Lock;
+ Try
+ FBTree.FSearching_AccountNumber := -1;
+ i := AAccountNumber;
+ Result := FBTree.FindSuccessor(i,i);
+ AAccountNumber := i;
+ Finally
+ FBTree.Unlock;
+ End;
+end;
+
+function TAccountsOrderedByUpdatedBlock.Update(const AAccountNumber, AOldUpdatedBlock, ANewUpdatedBlock: Integer): Boolean;
+var
+ Lampos : TAbstractMemPosition;
+ Lnode : TAbstractBTree.TAbstractBTreeNode;
+ LAccount : TAccount;
+ LPosition : TAbstractMemPosition;
+ LiPos : Integer;
+begin
+ FBTree.Lock;
+ Try
+ FBTree.FSearching_AccountNumber := AAccountNumber;
+ FBTree.FSearching_UpdatedBlock := AOldUpdatedBlock;
+ FBTree.Delete(AAccountNumber);
+ FBTree.FSearching_UpdatedBlock := ANewUpdatedBlock;
+ FBTree.Add(AAccountNumber);
+ Finally
+ FBTree.Unlock;
+ End;
+ Result := True;
+end;
+
+{ TAccountsOrderedByUpdatedBlock.TAccounstByUpdatedBlockBTree }
+
+function TAccountsOrderedByUpdatedBlock.TAccounstByUpdatedBlockBTree.DoCompareData(
+ const ALeftData, ARightData: TAbstractMemPosition): Integer;
+var LLeftAccount, LRightAccount : TAccount;
+begin
+ if (ALeftData = ARightData) then Exit(0);
+
+ FCallReturnAccount(ARightData,LRightAccount);
+ if ((FSearching_AccountNumber>=0) And (ALeftData=FSearching_AccountNumber)) then begin
+ Result := FSearching_UpdatedBlock - LRightAccount.updated_on_block_active_mode;
+ end else begin
+ FCallReturnAccount(ALeftData,LLeftAccount);
+ Result := LLeftAccount.updated_on_block_active_mode - LRightAccount.updated_on_block_active_mode;
+ end;
+ if Result=0 then Result := ALeftData - ARightData;
+end;
+
+function TAccountsOrderedByUpdatedBlock.TAccounstByUpdatedBlockBTree.NodeDataToString(
+ const AData: TAbstractMemPosition): String;
+var LAccount : TAccount;
+begin
+ if FCallReturnAccount(AData,LAccount) then begin
+ Result := Format('(Acc:%d Upd:%d)',[LAccount.account,LAccount.updated_on_block_active_mode]);
+ end else Result := Format('(Pos:%d not found)',[AData]);
+end;
+
+{ TAccounstBySalePrice }
+
+constructor TAccountsOrderedBySalePrice.Create({$IFDEF USE_ABSTRACTMEM}AAbstractMem: TAbstractMem;
+ const AInitialZone: TAMZone; {$ENDIF}ACallReturnAccount: TCallReturnAccount);
+begin
+ {$IFDEF USE_ABSTRACTMEM}
+ inherited Create(AAbstractMem,AInitialZone,False,15);
+ {$ELSE}
+ inherited Create(Nil,False,15);
+ {$ENDIF}
+ FCallReturnAccount := ACallReturnAccount;
+ FSearching_AccountNumber := -1;
+ FSearching_AccountInfo.Clear;
+end;
+
+function TAccountsOrderedBySalePrice.DoCompareData(const ALeftData,
+ ARightData: TAbstractMemPosition): Integer;
+var LLeftAccount, LRightAccount : TAccount;
+ LopResult : Int64;
+begin
+ if (ALeftData = ARightData) then Exit(0);
+
+ FCallReturnAccount(ARightData,LRightAccount);
+ if ((FSearching_AccountNumber>=0) And (ALeftData=FSearching_AccountNumber)) then begin
+ LopResult := FSearching_AccountInfo.price - LRightAccount.accountInfo.price;
+ end else begin
+ FCallReturnAccount(ALeftData,LLeftAccount);
+ LopResult := LLeftAccount.accountInfo.price - LRightAccount.accountInfo.price;
+ end;
+ if LopResult<0 then Result := -1
+ else if LopResult>0 then Result := 1
+ else Result := ALeftData - ARightData;
+end;
+
+function TAccountsOrderedBySalePrice.NodeDataToString(
+ const AData: TAbstractMemPosition): String;
+var LAccount : TAccount;
+begin
+ if FCallReturnAccount(AData,LAccount) then begin
+ Result := Format('(Acc:%d price:%s)',[LAccount.account,TAccountComp.FormatMoney(LAccount.accountInfo.price)]);
+ end else Result := Format('(Pos:%d not found)',[AData]);
+end;
+
+function TAccountsOrderedBySalePrice.UpdateAccountBySalePrice(const AAccountNumber: Integer;
+ const AOldAccountInfo, ANewAccountInfo: TAccountInfo): Boolean;
+var Ldone : Boolean;
+begin
+ if (TAccountComp.IsAccountForSale(AOldAccountInfo)=TAccountComp.IsAccountForSale(ANewAccountInfo)) and
+ (AOldAccountInfo.price = ANewAccountInfo.price) then Exit(True); // No updates, no need to change
+ Lock;
+ Try
+ FSearching_AccountNumber := AAccountNumber;
+ FSearching_AccountInfo := AOldAccountInfo;
+ Ldone := Delete(AAccountNumber);
+ if (Ldone) and (Not TAccountComp.IsAccountForSale(AOldAccountInfo)) then raise EAbsctractMemAccounts.Create('ERROR DEV 20210126-1');
+ if (Not Ldone) and (TAccountComp.IsAccountForSale(AOldAccountInfo)) then raise EAbsctractMemAccounts.Create('ERROR DEV 20210126-2');
+ FSearching_AccountInfo := ANewAccountInfo;
+ if (TAccountComp.IsAccountForSale(ANewAccountInfo)) then begin
+ if Not Add(AAccountNumber) then raise EAbsctractMemAccounts.Create('ERROR DEV 20210126-3');
+ end;
+ FSearching_AccountNumber := -1;
+ FSearching_AccountInfo.Clear;
+ Finally
+ Unlock;
+ End;
+ Result := True;
+end;
+
+end.
diff --git a/src/core/UPCDataTypes.pas b/src/core/UPCDataTypes.pas
index f94fb6c94..3f6e40313 100644
--- a/src/core/UPCDataTypes.pas
+++ b/src/core/UPCDataTypes.pas
@@ -47,6 +47,7 @@ TECDSA_Public = record
function FromSerialized(const AStream : TStream) : Boolean; overload;
function LoadFromTBytes(const ABytes : TBytes; var AStartIndex : Integer) : Boolean;
function IsEqualTo(const ACompareTo : TECDSA_Public) : Boolean;
+ function GetCopy : TECDSA_Public;
end;
{ TECDSA_Public_Raw is a TECDSA_Public stored in a single TRawBytes
@@ -65,6 +66,7 @@ TECDSA_Public_Helper = record helper for TECDSA_Public
TECDSA_SIG = record
r: TRawBytes;
s: TRawBytes;
+ function GetCopy : TECDSA_SIG;
end;
PECDSA_Public = ^TECDSA_Public; // Pointer to a TECDSA_SIG
@@ -91,6 +93,7 @@ TECDSA_SIG = record
function ToSerialized : TBytes;
function FromSerialized(const ASerialized : TBytes) : Boolean;
function LoadFromTBytes(const ABytes : TBytes; var AStartIndex : Integer) : Boolean;
+ function GetCopy : TAccountInfo;
end;
TOperationBlock = Record
@@ -108,6 +111,7 @@ TECDSA_SIG = record
operations_hash: TRawBytes; // RAW sha256 (32 bytes) of Operations
proof_of_work: TRawBytes; // RAW 32 bytes
previous_proof_of_work: TRawBytes; // RAW 32 bytes
+ function GetCopy : TOperationBlock;
end;
{ TAccount }
@@ -125,6 +129,7 @@ TECDSA_SIG = record
account_seal : TRawBytes; // Protocol 5. PIP-0029 seal of data changes
procedure Clear;
function GetLastUpdatedBlock : Cardinal;
+ function GetCopy : TAccount;
End;
PAccount = ^TAccount;
@@ -199,6 +204,13 @@ function TECDSA_Public.FromSerialized(const ASerialized: TBytes): Boolean;
Result := LoadFromTBytes(ASerialized,i);
end;
+function TECDSA_Public.GetCopy: TECDSA_Public;
+begin
+ Result.EC_OpenSSL_NID := Self.EC_OpenSSL_NID;
+ Result.x := Copy(Self.x);
+ Result.y := Copy(Self.y);
+end;
+
function TECDSA_Public.FromSerialized(const AStream: TStream): Boolean;
begin
if AStream.Read(Self.EC_OpenSSL_NID,2)<>2 then Exit(False);
@@ -301,6 +313,14 @@ function TAccountInfo.FromSerialized(const ASerialized: TBytes): Boolean;
Result := LoadFromTBytes(ASerialized,i);
end;
+function TAccountInfo.GetCopy: TAccountInfo;
+begin
+ Result := Self;
+ Result.accountKey := Self.accountKey.GetCopy;
+ Result.new_publicKey := Self.new_publicKey.GetCopy;
+ Result.hashed_secret := Copy(Self.hashed_secret);
+end;
+
function TAccountInfo.LoadFromTBytes(const ABytes: TBytes; var AStartIndex: Integer): Boolean;
var w : Word;
begin
@@ -394,6 +414,15 @@ procedure TAccount.Clear;
Self := CT_Account_NUL;
end;
+function TAccount.GetCopy: TAccount;
+begin
+ Result := Self;
+ Result.accountInfo := Self.accountInfo.GetCopy;
+ Result.name := Copy(Self.name);
+ Result.account_data := Copy(Self.account_data);
+ Result.account_seal := Copy(Self.account_seal);
+end;
+
function TAccount.GetLastUpdatedBlock: Cardinal;
begin
if (Self.updated_on_block_passive_mode>Self.updated_on_block_active_mode) then Result := Self.updated_on_block_passive_mode
@@ -438,5 +467,26 @@ function TPCSafeBoxHeader.ToString: String;
+{ TOperationBlock }
+
+function TOperationBlock.GetCopy: TOperationBlock;
+begin
+ Result := Self;
+ Result.account_key := Self.account_key.GetCopy;
+ Result.block_payload := Copy(Self.block_payload);
+ Result.initial_safe_box_hash := Copy(Self.initial_safe_box_hash);
+ Result.operations_hash := Copy(Self.operations_hash);
+ Result.proof_of_work := Copy(Self.proof_of_work);
+ Result.previous_proof_of_work := Copy(Self.previous_proof_of_work);
+end;
+
+{ TECDSA_SIG }
+
+function TECDSA_SIG.GetCopy: TECDSA_SIG;
+begin
+ Result.r := Copy(Self.r);
+ Result.s := Copy(Self.s);
+end;
+
end.
diff --git a/src/core/UPCDownloadSafebox.pas b/src/core/UPCDownloadSafebox.pas
new file mode 100644
index 000000000..4298de869
--- /dev/null
+++ b/src/core/UPCDownloadSafebox.pas
@@ -0,0 +1,300 @@
+unit UPCDownloadSafebox;
+
+{ Copyright (c) 2016-2023 by Albert Molina
+
+ Distributed under the MIT software license, see the accompanying file LICENSE
+ or visit http://www.opensource.org/licenses/mit-license.php.
+
+ This unit is a part of the PascalCoin Project, an infinitely scalable
+ cryptocurrency. Find us here:
+ Web: https://www.pascalcoin.org
+ Source: https://github.com/PascalCoin/PascalCoin
+
+ If you like it, consider a donation using Bitcoin:
+ 16K3HCZRhFUtM8GdWRcfKeaa6KsuyxZaYk
+
+ THIS LICENSE HEADER MUST NOT BE REMOVED.
+}
+
+{$IFDEF FPC}
+ {$mode delphi}
+{$ENDIF}
+
+interface
+
+{$I ./../config.inc}
+
+uses
+ Classes, SysUtils,
+ UNetProtocol, UThread,
+ {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF},
+ UBlockChain,
+ UNode, UPCTemporalFileStream, UChunk,
+ UAccounts, ULog, UConst, UCrypto, UBaseTypes, UPCDataTypes;
+
+type
+ TPCDownloadSafebox = class
+ private
+ FDownloadedBank: TPCBank;
+ FOnProgressNotify: TProgressNotify;
+ type
+ TDownloadSBThread = Class(TPCThread)
+ private
+ FOwner : TPCDownloadSafebox;
+ FBlockStart, FBlocksCount : Cardinal;
+ FStream: TPCTemporalFileStream;
+ protected
+ procedure BCExecute; override;
+ public
+ constructor Create(AOwner : TPCDownloadSafebox; ABlockStart, ACount : Cardinal);
+ destructor Destroy; override;
+ Property Stream : TPCTemporalFileStream read FStream write FStream;
+ End;
+ TPCDownloadSafeboxChunk = record
+ BlockStart : Cardinal;
+ Count : Cardinal;
+ Thread : TDownloadSBThread;
+ end;
+ var
+ FNode : TNode;
+ FSavedSafeboxHighOperationBlock : TOperationBlock;
+ FChunks : TPCThreadList;
+ protected
+ public
+ constructor Create;
+ destructor Destroy; override;
+ function DownloadSafebox(AOwnerThread : TThread; ASavedSafeboxHighOperationBlock : TOperationBlock; AChunks : TPCSafeboxChunks) : Boolean;
+ property DownloadedBank : TPCBank read FDownloadedBank;
+ property OnProgressNotify : TProgressNotify read FOnProgressNotify write FOnProgressNotify;
+ end;
+
+implementation
+
+{ TPCDownloadSafebox.TDownloadSBThread }
+
+procedure TPCDownloadSafebox.TDownloadSBThread.BCExecute;
+ function DownloadSafebox(AConnection : TNetConnection; ASafeboxHash : TRawBytes; ASafeboxChunkStream : TStream) : Boolean;
+ Var sendData,receiveData : TStream;
+ headerdata : TNetHeaderData;
+ request_id : Cardinal;
+ c : Cardinal;
+ LRandomMilis : Integer;
+ LsafeBoxHeader : TPCSafeBoxHeader;
+ LErrors : String;
+ Ltc : TTickCount;
+ Begin
+ Result := False;
+ Ltc := TPlatform.GetTickCount;
+ sendData := TMemoryStream.Create;
+ receiveData := TMemoryStream.Create;
+ try
+ c := FOwner.FSavedSafeboxHighOperationBlock.block;
+ sendData.Write(c,4); // 4 bytes for blockcount
+ TStreamOp.WriteAnsiString(SendData,ASafeboxHash); // SafeboxHash
+ sendData.Write(FBlockStart,4);
+ c := FBlockStart + FBlocksCount - 1;
+ sendData.Write(c,4);
+ //
+ request_id := TNetData.NetData.NewRequestId;
+ if AConnection.DoSendAndWaitForResponse(CT_NetOp_GetSafeBox,request_id,sendData,receiveData,30000,headerdata) then begin
+ if HeaderData.is_error then exit;
+ ASafeboxChunkStream.Position := 0;
+ ASafeboxChunkStream.Size:=0;
+ If Not TPCChunk.LoadSafeBoxFromChunk(receiveData,ASafeboxChunkStream,LsafeBoxHeader,LErrors) then begin
+ AConnection.DisconnectInvalidClient(false,'Invalid received chunk: '+LErrors);
+ exit;
+ end;
+ If (Not (TBaseType.Equals(LsafeBoxHeader.safeBoxHash,ASafeboxHash))) or (LsafeBoxHeader.startBlock<>FBlockStart) or (LsafeBoxHeader.endBlock<>c) or
+ (LsafeBoxHeader.protocolCT_BlockChain_Protocol_Available) then begin
+ Lerrors := Format('Invalid received Safebox chunk Blockscount:%d %d - from:%d %d to %d %d - SafeboxHash:%s %s - Protocol %d',
+ [LsafeBoxHeader.blocksCount,FBlocksCount,LsafeBoxHeader.startBlock,FBlockStart,LsafeBoxHeader.endBlock,c,
+ LsafeBoxHeader.safeBoxHash.ToHexaString,ASafeboxHash.ToHexaString,LsafeBoxHeader.protocol]);
+ AConnection.DisconnectInvalidClient(false,'Invalid received chunk: '+Lerrors);
+ exit;
+ end;
+ Result := True;
+ TLog.NewLog(ltdebug,Self.ClassName,Format('Received Safebox chunk %d..%d from %s in %.2f secs',[FBlockStart,FBlockStart+FBlocksCount,AConnection.ClientRemoteAddr,TPlatform.GetElapsedMilliseconds(Ltc)/1000]));
+ end else begin
+ Lerrors := 'No response on DownloadSafeBoxChunk';
+ TLog.NewLog(ltdebug,Self.ClassName,Lerrors);
+ end;
+ finally
+ receiveData.Free;
+ sendData.Free;
+ end;
+ end;
+var LConnection : TNetConnection;
+begin
+ repeat
+ FStream.Position := 0;
+ FStream.Size := 0; // Clear
+ // Search for a connection
+ FOwner.FChunks.LockList;
+ try
+ if TNetData.NetData.GetConnection(Random(TNetData.NetData.ConnectionsCountAll),LConnection) then begin
+ if Assigned(LConnection) And (Not LConnection.Connected) then LConnection := Nil;
+ end else LConnection := Nil;
+ if Assigned(LConnection) then begin
+ if TNetData.NetData.ConnectionLock(Self,LConnection,100) then begin
+ TNetData.NetData.ConnectionUnlock(LConnection);
+ end else LConnection := Nil;
+ end;
+ finally
+ FOwner.FChunks.UnlockList;
+ end;
+ if Assigned(LConnection) then begin
+ if DownloadSafebox(LConnection,FOwner.FSavedSafeboxHighOperationBlock.initial_safe_box_hash,Self.FStream) then Break;
+ end;
+ Sleep(100);
+ until Terminated;
+end;
+
+constructor TPCDownloadSafebox.TDownloadSBThread.Create(AOwner : TPCDownloadSafebox; ABlockStart, ACount : Cardinal);
+begin
+ FOwner := AOwner;
+ FBlockStart := ABlockStart;
+ FBlocksCount := ACount;
+ FStream := TPCTemporalFileStream.Create(Format('CHUNK_%.8d_%.8d',[ABlockStart,ABlockStart+ACount-1]));
+ inherited Create(True);
+
+ FreeOnTerminate := False;
+ Suspended := False;
+end;
+
+destructor TPCDownloadSafebox.TDownloadSBThread.Destroy;
+begin
+ FreeAndNil(FStream);
+ inherited;
+end;
+
+{ TPCDownloadSafebox }
+
+constructor TPCDownloadSafebox.Create;
+begin
+ FNode := TNode.Node;
+ FDownloadedBank := TPCBank.Create(Nil);
+ FChunks := TPCThreadList.Create('');
+ FSavedSafeboxHighOperationBlock := CT_OperationBlock_NUL;
+ FOnProgressNotify := Nil;
+end;
+
+destructor TPCDownloadSafebox.Destroy;
+var i : Integer;
+ Ll : TList;
+begin
+ Ll := FChunks.LockList;
+ Try
+ for i:=0 to Ll.Count-1 do begin
+ if assigned(Ll.Items[i].Thread) then begin
+ Ll.Items[i].Thread.Terminate;
+ Ll.Items[i].Thread.WaitFor;
+ Ll.Items[i].Thread.Free;
+ end;
+ end;
+ Finally
+ FChunks.UnlockList;
+ End;
+ FreeAndNil(FChunks);
+ FreeAndNil(FDownloadedBank);
+ inherited;
+end;
+
+function TPCDownloadSafebox.DownloadSafebox(AOwnerThread : TThread; ASavedSafeboxHighOperationBlock: TOperationBlock; AChunks : TPCSafeboxChunks): Boolean;
+var LDownloadedSafeboxBlocksCount, request_id : Cardinal;
+ LreceivedChunk : TStream;
+ safeBoxHeader : TPCSafeBoxHeader;
+ i : Integer;
+ LContinue : Boolean;
+ Ll : TList;
+ Ldsbc : TPCDownloadSafeboxChunk;
+ LTerminated : Boolean;
+ LTerminatedCount, LTotal : Integer;
+ LFileName, Lstatus : String;
+Begin
+ Result := False;
+ // Check
+ LDownloadedSafeboxBlocksCount := ((ASavedSafeboxHighOperationBlock.block DIV CT_BankToDiskEveryNBlocks)) * CT_BankToDiskEveryNBlocks;
+ if LDownloadedSafeboxBlocksCount<>ASavedSafeboxHighOperationBlock.block then Exit(False);
+ FSavedSafeboxHighOperationBlock := ASavedSafeboxHighOperationBlock;
+
+ LTotal := 0;
+ Ll := FChunks.LockList;
+ Try
+ for i:=0 to ((LDownloadedSafeboxBlocksCount-1) DIV CT_MAX_SAFEBOXCHUNK_BLOCKS) do begin
+ Ldsbc.BlockStart := (i * CT_MAX_SAFEBOXCHUNK_BLOCKS);
+ Ldsbc.Count := CT_MAX_SAFEBOXCHUNK_BLOCKS;
+ if Ldsbc.BlockStart + Ldsbc.Count > LDownloadedSafeboxBlocksCount then begin
+ Ldsbc.Count := LDownloadedSafeboxBlocksCount - Ldsbc.BlockStart;
+ end;
+ Ldsbc.Thread := Nil;
+ Ll.Add(Ldsbc);
+ end;
+ LTotal := Ll.Count;
+ Finally
+ FChunks.UnlockList;
+ End;
+
+ if Assigned(AOwnerThread) then LContinue := Not AOwnerThread.CheckTerminated
+ else LContinue := True;
+
+ LTerminated := False;
+
+ while (FNode.NetServer.Active) And LContinue And (Not LTerminated) do begin
+ //
+ LTerminatedCount := 0;
+ Ll := FChunks.LockList;
+ Try
+ i := 0;
+ for i:=0 to Ll.Count-1 do begin
+ Ldsbc := Ll.Items[i];
+ if Not Assigned(Ldsbc.Thread) then begin
+ Ldsbc.Thread := TPCDownloadSafebox.TDownloadSBThread.Create(Self,Ldsbc.BlockStart,Ldsbc.Count);
+ Ll.Items[i] := Ldsbc;
+ end else begin
+ if Ldsbc.Thread.Terminated then Inc(LTerminatedCount);
+ end;
+ end;
+ LTerminated := LTerminatedCount >= Ll.Count;
+ Lstatus := Format('Downloading Safebox chunks %d/%d',[LTerminatedCount,Ll.Count]);
+ Finally
+ FChunks.UnlockList;
+ End;
+
+ Sleep(10);
+ //
+ if Assigned(AOwnerThread) then LContinue := Not AOwnerThread.CheckTerminated
+ else LContinue := True;
+ if (LContinue) and (Assigned(FOnProgressNotify)) then begin
+ FOnProgressNotify(Self,LStatus,LTerminatedCount,LTotal);
+ end;
+ end;
+
+ if (LTerminated) And (LContinue) then begin
+ AChunks.Clear;
+ Ll := FChunks.LockList;
+ try
+ for i := 0 to Ll.Count-1 do begin
+ Ll.Items[i].Thread.Stream.Position := 0;
+ AChunks.AddChunk(Ll.Items[i].Thread.Stream,True,True);
+ Ll.Items[i].Thread.Stream := Nil;
+ end;
+ LFileName := TNode.Node.Bank.GetStorageFolder('')+PathDelim+'safebox_'+IntToStr(LDownloadedSafeboxBlocksCount)+'.safebox';
+
+ if (Assigned(FOnProgressNotify)) then begin
+ FOnProgressNotify(Self,Format('Saving Safebox %d chunks to %s',[LTotal,ExtractFileName(LFileName)]),0,0);
+ end;
+ AChunks.SaveSafeboxfile(LFileName);
+ finally
+ FChunks.UnlockList;
+ end;
+ //
+ Result := True;
+ end;
+
+
+end;
+
+initialization
+finalization
+end.
diff --git a/src/core/UPCOperationsSignatureValidator.pas b/src/core/UPCOperationsSignatureValidator.pas
index c7c53f6da..200f129b2 100644
--- a/src/core/UPCOperationsSignatureValidator.pas
+++ b/src/core/UPCOperationsSignatureValidator.pas
@@ -325,6 +325,9 @@ procedure TPCOperationsSignatureValidatorThread.BCExecute;
LOperation := FValidator.GetNextOperation(Self);
if Assigned(LOperation) then begin
if Not LOperation.HasValidSignature then begin
+ {$IFDEF TESTING_NO_POW_CHECK}
+ LIsValid := True;
+ {$ELSE}
// Only will validate if HasValidSignature is False (Not validated before)
try
LIsValid := LOperation.IsValidSignatureBasedOnCurrentSafeboxState(FValidator.FSafeBoxTransaction);
@@ -334,6 +337,7 @@ procedure TPCOperationsSignatureValidatorThread.BCExecute;
TLog.NewLog(lterror,ClassName,LOperation.ToString+' ERROR: ('+E.ClassName+') '+E.Message);
end;
end;
+ {$ENDIF}
FValidator.SetOperationCheckResult(Self,LOperation, LIsValid);
end;
end;
diff --git a/src/core/UPCOrderedLists.pas b/src/core/UPCOrderedLists.pas
index 3944d6854..20e4dc8f5 100644
--- a/src/core/UPCOrderedLists.pas
+++ b/src/core/UPCOrderedLists.pas
@@ -56,6 +56,8 @@ interface
Procedure Disable;
Procedure Enable;
Function ToArray : TCardinalsArray;
+ function FillList(AStartIndex, ACount : Integer; const AList : TList) : Integer; overload;
+ function FillList(AStartIndex, ACount : Integer; const AList : TList) : Integer; overload;
End;
@@ -180,6 +182,36 @@ procedure TOrderedCardinalList.Enable;
if (FDisabledsCount=0) And (FModifiedWhileDisabled) then NotifyChanged;
end;
+function TOrderedCardinalList.FillList(AStartIndex, ACount : Integer; const AList : TList) : Integer;
+var i : Integer;
+begin
+ AList.Clear;
+ AList.Capacity := ACount;
+ if (AStartIndex=0) and (ACount=FOrderedList.Count) then begin
+ AList.InsertRange(AStartIndex,FOrderedList);
+ end else begin
+ while (ACount>0) and (AStartIndex < FOrderedList.Count) do begin
+ AList.Add( FOrderedList.Items[AStartIndex] );
+ Inc(AStartIndex);
+ Dec(ACount);
+ end;
+ end;
+ Result := AList.Count;
+end;
+
+function TOrderedCardinalList.FillList(AStartIndex, ACount: Integer; const AList: TList): Integer;
+var i : Integer;
+begin
+ AList.Clear;
+ AList.Capacity := ACount;
+ while (ACount>0) and (AStartIndex < FOrderedList.Count) do begin
+ AList.Add( FOrderedList.Items[AStartIndex] );
+ Inc(AStartIndex);
+ Dec(ACount);
+ end;
+ Result := AList.Count;
+end;
+
function TOrderedCardinalList.Find(const Value: Cardinal; var Index: Integer): Boolean;
var L, H, I: Integer;
C : Int64;
diff --git a/src/core/UPCRPCFileUtils.pas b/src/core/UPCRPCFileUtils.pas
new file mode 100644
index 000000000..ff5c2f780
--- /dev/null
+++ b/src/core/UPCRPCFileUtils.pas
@@ -0,0 +1,180 @@
+unit UPCRPCFileUtils;
+
+{ Copyright (c) 2020 by PascalCoin developers, orignal code by Albert Molina
+
+ Distributed under the MIT software license, see the accompanying file LICENSE
+ or visit http://www.opensource.org/licenses/mit-license.php.
+
+ This unit is a part of the PascalCoin Project, an infinitely scalable
+ cryptocurrency. Find us here:
+ Web: https://www.pascalcoin.org
+ Source: https://github.com/PascalCoin/PascalCoin
+
+ If you like it, consider a donation using Bitcoin:
+ 16K3HCZRhFUtM8GdWRcfKeaa6KsuyxZaYk
+
+ THIS LICENSE HEADER MUST NOT BE REMOVED.
+}
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+interface
+
+{$I ./../config.inc}
+
+Uses classes, SysUtils,
+ UJSONFunctions, URPC, UCrypto, ULog,
+ {$IFDEF USE_ABSTRACTMEM}
+ UPCAbstractMem, UPCAbstractMemAccountKeys,
+ {$ENDIF}
+ {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF},
+ UBlockChain, UPCOrderedLists;
+
+
+Type
+
+ { TRPCFileUtils }
+
+ TRPCFileUtils = Class
+ private
+ public
+ class function SaveAsSafeboxStream(const ASender : TRPCProcess; const AMethodName : String; AInputParams, AJSONResponse : TPCJSONObject; var AErrorNum : Integer; var AErrorDesc : String) : Boolean;
+ class function GenerateNewAbstractMemSafebox(const ASender : TRPCProcess; const AMethodName : String; AInputParams, AJSONResponse : TPCJSONObject; var AErrorNum : Integer; var AErrorDesc : String) : Boolean;
+ class function AbstractMemStats(const ASender : TRPCProcess; const AMethodName : String; AInputParams, AJSONResponse : TPCJSONObject; var AErrorNum : Integer; var AErrorDesc : String) : Boolean;
+
+ End;
+
+implementation
+
+uses UPCDataTypes, UFileStorage, UNode;
+
+{ TRPCFileUtils }
+
+class function TRPCFileUtils.GenerateNewAbstractMemSafebox(
+ const ASender: TRPCProcess; const AMethodName: String; AInputParams,
+ AJSONResponse: TPCJSONObject; var AErrorNum: Integer;
+ var AErrorDesc: String): Boolean;
+{$IFDEF USE_ABSTRACTMEM}
+var
+ LFileName : String;
+{$ENDIF}
+begin
+ if Not ASender.RPCServer.AllowUsePrivateKeys then begin
+ AErrorNum := CT_RPC_ErrNum_NotAllowedCall;
+ Exit(False);
+ end;
+{$IFDEF USE_ABSTRACTMEM}
+ LFileName := AInputParams.AsString('filename', '').Trim;
+ if (LFileName='') then begin
+ LFileName := TPCBank.GetSafeboxCheckpointingFileName(TNode.Node.Bank.GetStorageFolder(''),TNode.Node.Bank.BlocksCount);
+ end;
+ TNode.Node.Bank.SafeBox.SaveCheckpointing(LFileName);
+ AJSONResponse.GetAsObject('result').GetAsVariant('filename').Value := LFileName;
+ AErrorNum := 0;
+ AErrorDesc := '';
+ Result := True;
+{$ELSE}
+ AErrorNum := CT_RPC_ErrNum_NotImplemented;
+ AErrorDesc := 'AbstractMem library is not available in this build';
+ Result := False;
+{$ENDIF}
+end;
+
+class function TRPCFileUtils.AbstractMemStats(const ASender: TRPCProcess;
+ const AMethodName: String; AInputParams, AJSONResponse: TPCJSONObject;
+ var AErrorNum: Integer; var AErrorDesc: String): Boolean;
+var LStrings, LReport : TStrings;
+ LTotalUsedSize, LTotalUsedBlocksCount, LTotalLeaksSize, LTotalLeaksBlocksCount : Int64;
+ i, nMax : Integer;
+ Lobj : TPCJSONObject;
+ Larray : TPCJSONArray;
+begin
+ if Not ASender.RPCServer.AllowUsePrivateKeys then begin
+ AErrorNum := CT_RPC_ErrNum_NotAllowedCall;
+ Exit(False);
+ end;
+{$IFDEF USE_ABSTRACTMEM}
+ LStrings := TStringList.Create;
+ Try
+ if AInputParams.GetAsVariant('report').AsBoolean(False) then LReport := LStrings
+ else LReport := Nil;
+ Lobj := AJSONResponse.GetAsObject('result').GetAsObject('abstractmem');
+ if TNode.Node.Bank.SafeBox.PCAbstractMem.AbstractMem.CheckConsistency(LReport,Nil, LTotalUsedSize, LTotalUsedBlocksCount, LTotalLeaksSize, LTotalLeaksBlocksCount) then begin
+ Lobj.GetAsVariant('checkconsistency').Value := True;
+ end else begin
+ Lobj.GetAsVariant('checkconsistency').Value := False;
+ end;
+ Lobj.GetAsVariant('total_used_size').Value := LTotalUsedSize;
+ Lobj.GetAsVariant('total_used_blocks_count').Value := LTotalUsedBlocksCount;
+ Lobj.GetAsVariant('total_leaks_size').Value := LTotalLeaksSize;
+ Lobj.GetAsVariant('total_leaks_blocks_count').Value := LTotalLeaksBlocksCount;
+
+ if Assigned(LReport) then begin
+ Larray := Lobj.GetAsArray('report');
+ i := AInputParams.GetAsVariant('report_start').AsInteger(0);
+ nMax := AInputParams.GetAsVariant('report_max').AsInteger(100);
+ while (nMax>0) and (i>=0) and (i;
begin
// Get Parameters
Result := False;
@@ -175,6 +177,7 @@ class function TRPCFindAccounts.FindAccounts(const ASender: TRPCProcess;
end;
LAccountType := AInputParams.AsInteger('type', -1);
LStart := AInputParams.AsInteger('start', 0);
+ LEnd := AInputParams.AsInteger('end', -1);
LMax := AInputParams.AsInteger('max', 100);
if AInputParams.IndexOfName('statustype')>=0 then begin
LString := AInputParams.AsString('statustype','all');
@@ -203,7 +206,7 @@ class function TRPCFindAccounts.FindAccounts(const ASender: TRPCProcess;
// Validate Parameters
if (Length(LAccountName)>0) And (LSearchByNameType = st_exact) then begin
LRaw.FromString( LAccountName );
- if not ASender.Node.Bank.SafeBox.ValidAccountName(LRaw, LErrors) then begin
+ if not TPascalCoinProtocol.IsValidAccountName(CT_BUILD_PROTOCOL, LRaw, LErrors) then begin
AErrorNum := CT_RPC_ErrNum_InvalidAccountName;
AErrorDesc := LErrors;
exit;
@@ -221,6 +224,10 @@ class function TRPCFindAccounts.FindAccounts(const ASender: TRPCProcess;
exit;
end;
+ if (LEnd<0) or (LEnd>=ASender.Node.Bank.AccountsCount) then begin
+ LEnd := ASender.Node.Bank.AccountsCount - 1;
+ end;
+
// Declare return result (empty by default)
LOutput := AJSONResponse.GetAsArray('result');
@@ -271,17 +278,31 @@ class function TRPCFindAccounts.FindAccounts(const ASender: TRPCProcess;
end;
end else begin
// Search by type-forSale-balance
- for i := LStart to ASender.Node.Bank.AccountsCount - 1 do begin
- if (LSearchByPubkey) then begin
- if (i>=LAccountsNumbersList.Count) then Break;
- LAccount := ASender.Node.GetMempoolAccount( LAccountsNumbersList.Get(i) );
- end else begin
- LAccount := ASender.Node.GetMempoolAccount(i);
+ if (LSearchByPubkey) then begin
+ LAccountsList := TList.Create;
+ try
+ LAccountsNumbersList.FillList(LStart,LEnd-LStart+1,LAccountsList);
+ for i := 0 to LAccountsList.Count-1 do begin
+ LAccount := ASender.Node.GetMempoolAccount( LAccountsList[i] );
+ if (_IsValidAccount(LAccount)) then begin
+ TPascalCoinJSONComp.FillAccountObject(LAccount,LOutput.GetAsObject(LOutput.Count));
+ if LOutput.Count>=LMax then break;
+ end;
+ end;
+ finally
+ LAccountsList.Free;
end;
+ end else begin
+ i := LStart;
+ while (Not ASender.Terminated) And (i < LEnd) do begin
+ LAccount := ASender.Node.GetMempoolAccount(i);
+
+ if (_IsValidAccount(LAccount)) then begin
+ TPascalCoinJSONComp.FillAccountObject(LAccount,LOutput.GetAsObject(LOutput.Count));
+ if LOutput.Count>=LMax then break;
+ end;
+ inc(i);
- if (_IsValidAccount(LAccount)) then begin
- TPascalCoinJSONComp.FillAccountObject(LAccount,LOutput.GetAsObject(LOutput.Count));
- if LOutput.Count>=LMax then break;
end;
end;
end;
diff --git a/src/core/UPCRPCFindBlocks.pas b/src/core/UPCRPCFindBlocks.pas
new file mode 100644
index 000000000..887d33f8b
--- /dev/null
+++ b/src/core/UPCRPCFindBlocks.pas
@@ -0,0 +1,191 @@
+unit UPCRPCFindBlocks;
+
+{ Copyright (c) 2020 by PascalCoin developers, orignal code by Albert Molina
+
+ Distributed under the MIT software license, see the accompanying file LICENSE
+ or visit http://www.opensource.org/licenses/mit-license.php.
+
+ This unit is a part of the PascalCoin Project, an infinitely scalable
+ cryptocurrency. Find us here:
+ Web: https://www.pascalcoin.org
+ Source: https://github.com/PascalCoin/PascalCoin
+
+ If you like it, consider a donation using Bitcoin:
+ 16K3HCZRhFUtM8GdWRcfKeaa6KsuyxZaYk
+
+ THIS LICENSE HEADER MUST NOT BE REMOVED.
+}
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+interface
+
+{$I ./../config.inc}
+
+Uses classes, SysUtils,
+ UJSONFunctions, UAccounts, UBaseTypes, UOpTransaction, UConst,
+ {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF},
+ URPC, UCrypto, UWallet, UBlockChain, ULog, UPCOrderedLists;
+
+
+Type
+ TRPCFindBlocks = Class
+ private
+ public
+ class function FindBlocks(const ASender : TRPCProcess; const AMethodName : String; AInputParams, AJSONResponse : TPCJSONObject; var AErrorNum : Integer; var AErrorDesc : String) : Boolean;
+ End;
+
+implementation
+
+uses UPCDataTypes;
+
+{ TRPCFindBlocks }
+
+class function TRPCFindBlocks.FindBlocks(const ASender: TRPCProcess;
+ const AMethodName: String; AInputParams, AJSONResponse: TPCJSONObject;
+ var AErrorNum: Integer; var AErrorDesc: String): Boolean;
+
+
+{ RPC "findblocks"
+### findblocks
+Find blocks by name/type and returns them as an array of "Block Object"
+
+##### Params
+- `payload` : String - Name to search
+- `payloadsearchtype` : String - One of those values
+ - `exact` :
+ - `startswith` : (DEFAULT OPTION)
+ - `not-startswith` :
+ - `contains` :
+ - `not-contains` :
+ - `endswith` :
+ - `not-endswith` :
+- `enc_pubkey` or `b58_pubkey` : HEXASTRING or String - Will return blocks with this public key.
+- `start` : Integer - Start block (by default, 0)
+- `end` : Integer - End block (by default -1, equals to "no limit")
+- `max` : Integer - Max of accounts returned in array (by default, 100)
+
+}
+
+type
+ TSearchBlockPayloadType = (st_exact, st_startswith, st_contains, st_endswith, st_not_startswith, st_not_contains, st_not_endswith);
+
+ function _SearchValidPayload(const ASearch : String; const APayload : String; ASearchType : TSearchBlockPayloadType) : Boolean;
+ var i : Integer;
+ begin
+ if (ASearch.Length=0) then Exit(True); // If nothing to search, allways TRUE
+ // Here we know that ASearchName has a value
+ if (APayload.Length=0) then Exit(False); // If account has NO NAME, allways FALSE
+ if (ASearchType=st_exact) then begin
+ Exit( APayload.Equals(ASearch) ); // Must match
+ end;
+
+ i := APayload.IndexOf(ASearch);
+ Result :=
+ ((i=0) and (ASearchType in [st_startswith])) // found at first position
+ or
+ ((i>=0) and (ASearchType in [st_contains])) // found in any pos
+ or
+ ((i=(APayload.Length-1)) and (ASearchType in [st_endswith])) // found at last position
+ or
+ ((i<0) and (ASearchType in [st_not_startswith, st_not_contains, st_not_endswith])) // not found and must not contain in any pos
+ or
+ ((i>=1) and (ASearchType in [st_not_startswith])) // not found at first position
+ or
+ ((i<(APayload.Length-1)) and (ASearchType in [st_not_endswith])); // not found at last position
+ end;
+
+var
+ LPayload : String;
+ LSearchByPayloadType : TSearchBlockPayloadType;
+ LSearchByPubkey : Boolean;
+ LPubKey : TAccountKey;
+
+ function _IsValidBlock(const ABlock : TOperationBlock) : Boolean;
+ begin
+ if (Not _SearchValidPayload(LPayload,ABlock.block_payload.ToString,LSearchByPayloadType)) then Exit(False);
+ if (LSearchByPubkey) then begin
+ if Not (TAccountComp.EqualAccountKeys(LPubKey,ABlock.account_key)) then Exit(False);
+ end;
+
+ Result := True;
+ end;
+
+var
+ LString : String;
+ LAccountNumber : Integer;
+ LRaw : TRawBytes;
+ LStart, LEnd, LMax : Integer;
+ LBlock : TOperationBlock;
+
+ i : Integer;
+ LErrors : String;
+ LOutput : TPCJSONArray;
+ LStartsWith : TOrderedRawList;
+begin
+ // Get Parameters
+ Result := False;
+ LPayload := LowerCase(AInputParams.AsString('payload', '')); // Convert to lowercase...
+ if AInputParams.IndexOfName('payloadsearchtype')>=0 then begin
+ LString := AInputParams.AsString('payloadsearchtype','');
+ if (AnsiSameStr(LString,'exact')) then LSearchByPayloadType := st_exact
+ else if (AnsiSameStr(LString,'startswith')) then LSearchByPayloadType := st_startswith
+ else if (AnsiSameStr(LString,'not-startswith')) then LSearchByPayloadType := st_not_startswith
+ else if (AnsiSameStr(LString,'contains')) then LSearchByPayloadType := st_contains
+ else if (AnsiSameStr(LString,'not-contains')) then LSearchByPayloadType := st_not_contains
+ else if (AnsiSameStr(LString,'endswith')) then LSearchByPayloadType := st_endswith
+ else if (AnsiSameStr(LString,'not-endswith')) then LSearchByPayloadType := st_not_endswith
+ else begin
+ AErrorNum := CT_RPC_ErrNum_InvalidData;
+ AErrorDesc := Format('Invalid "payloadsearchtype" value: "%s"',[LString]);
+ Exit(False);
+ end;
+ end else begin
+ LSearchByPayloadType := st_startswith;
+ end;
+ LStart := AInputParams.AsInteger('start', 0);
+ LMax := AInputParams.AsInteger('max', 100);
+ LEnd := AInputParams.AsInteger('end', -1);
+
+ if LStart < 0 then begin
+ AErrorNum := CT_RPC_ErrNum_InvalidData;
+ AErrorDesc := '"start" param must be >=0';
+ exit;
+ end;
+ if LMax <= 0 then begin
+ AErrorNum := CT_RPC_ErrNum_InvalidData;
+ AErrorDesc := '"max" param must be greater than zero';
+ exit;
+ end;
+
+ if (LEnd<0) or (LEnd>=ASender.Node.Bank.SafeBox.BlocksCount) then begin
+ LEnd := ASender.Node.Bank.SafeBox.BlocksCount - 1;
+ end;
+
+ // Declare return result (empty by default)
+ LOutput := AJSONResponse.GetAsArray('result');
+
+ // Search by PubKey (if provided)
+ If TPascalCoinJSONComp.CapturePubKey(AInputParams, '',LPubKey,LErrors) then begin
+ LSearchByPubkey := True;
+ end else LSearchByPubkey := False;
+ //
+ i := LStart;
+ while (Not ASender.Terminated) And (i < LEnd) do begin
+ LBlock := ASender.Node.Bank.SafeBox.GetBlockInfo(i);
+ if (_IsValidBlock(LBlock)) then begin
+ TPascalCoinJSONComp.FillBlockObject(i,ASender.Node,LOutput.GetAsObject(LOutput.Count));
+ if LOutput.Count>=LMax then break;
+ end;
+ inc(i);
+ end;
+ Result := True;
+end;
+
+initialization
+ TRPCProcess.RegisterProcessMethod('findblocks',TRPCFindBlocks.FindBlocks);
+finalization
+ TRPCProcess.UnregisterProcessMethod('findblocks');
+end.
diff --git a/src/core/UPCRPCOpData.pas b/src/core/UPCRPCOpData.pas
index ad832f229..0f7c9c89a 100644
--- a/src/core/UPCRPCOpData.pas
+++ b/src/core/UPCRPCOpData.pas
@@ -27,7 +27,7 @@ interface
Uses classes, SysUtils,
UJSONFunctions, UAccounts, UBaseTypes, UOpTransaction, UConst, UPCDataTypes,
{$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF},
- URPC, UCrypto, UWallet, UBlockChain, ULog;
+ URPC, UCrypto, UEPasa, UWallet, UBlockChain, ULog;
Type
@@ -132,7 +132,28 @@ class function TRPCOpData.OpData_FindOpDataOperations(
end;
end;
- var LOpComp : TPCOperationsComp;
+ function DoAddOpData(AOpData : TOpData; var AFoundCounter : Integer; out AOperationResume : TOperationResume) : Boolean;
+ begin
+ Result := False;
+ // Search by filter:
+ if ((Not ASearchBySender) Or (ASearchSender = AOpData.Data.account_sender))
+ and ((Not ASearchByTarget) Or (ASearchTarget = AOpData.Data.account_target))
+ and ((Not ASearchByGUID) Or (EqualGUIDs(ASearchGUID,AOpData.Data.guid)))
+ and ((Not ASearchByDataSequence) Or (ASearchDataSequence = AOpData.Data.dataSequence))
+ and ((Not ASearchByDataType) Or (ASearchDataType = AOpData.Data.dataType))
+ then begin
+ if (AFoundCounter>=AStartOperation) And (AFoundCounter<=AEndOperation) then begin
+ If TPCOperation.OperationToOperationResume(ABlock_number,AOpData,False,AOpData.SignerAccount,AOperationResume) then begin
+ AOperationResume.Balance:=-1;
+ Result := True;
+ end;
+ end;
+ inc(AFoundCounter);
+ end;
+ end; // For LList...
+
+
+ var LOpComp, LMemPool : TPCOperationsComp;
LOperation : TPCOperation;
LOpData : TOpData;
LOperationResume : TOperationResume;
@@ -148,6 +169,39 @@ class function TRPCOpData.OpData_FindOpDataOperations(
Try
LList := TList.Create;
try
+ // Mempool
+ if ABlock_number>=ASender.Node.Bank.BlocksCount then begin
+ // Search mempool
+ LMemPool := ASender.Node.LockMempoolRead;
+ try
+ LMemPool.OperationsHashTree.GetOperationsAffectingAccount(ASearchedAccount_number,LList);
+ LFound_in_block := False;
+ // Reverse order:
+ for i := LList.Count - 1 downto 0 do begin
+ LOperation := LMemPool.Operation[LList.Items[i]];
+ if LOperation is TOpData then begin
+ //
+ LOpData := TOpData( LOperation );
+ if DoAddOpData(LOpData,LFoundCounter,LOperationResume) then begin
+ LOperationResume.NOpInsideBlock:=LList.Items[i];
+ LOperationResume.Block:=ASender.Node.Bank.BlocksCount;
+ AOperationsResumeList.Add(LOperationResume);
+ LFound_in_block := True;
+ end;
+ end;
+ end; // For LList...
+ If (Not LFound_in_block) And (AFirst_Block_Is_Unknown) then begin
+ ABlock_number := ASender.Node.Bank.BlocksCount - 1;
+ end else begin
+ ABlock_number := LMemPool.PreviousUpdatedBlocks.GetPreviousUpdatedBlock(ASearchedAccount_number,ASender.Node.Bank.BlocksCount - 1);
+ end;
+ finally
+ ASender.Node.UnlockMempoolRead;
+ end;
+ end;
+
+
+
LLast_block_number := ABlock_number+1;
while (LLast_block_number>ABlock_number) And (AAct_depth>0)
And (ABlock_number >= (ASearchedAccount_number DIV CT_AccountsPerBlock))
@@ -171,22 +225,11 @@ class function TRPCOpData.OpData_FindOpDataOperations(
if LOperation is TOpData then begin
//
LOpData := TOpData( LOperation );
- // Search by filter:
- if ((Not ASearchBySender) Or (ASearchSender = LOpData.Data.account_sender))
- and ((Not ASearchByTarget) Or (ASearchTarget = LOpData.Data.account_target))
- and ((Not ASearchByGUID) Or (EqualGUIDs(ASearchGUID,LOpData.Data.guid)))
- and ((Not ASearchByDataSequence) Or (ASearchDataSequence = LOpData.Data.dataSequence))
- and ((Not ASearchByDataType) Or (ASearchDataType = LOpData.Data.dataType))
- then begin
- if (LFoundCounter>=AStartOperation) And (LFoundCounter<=AEndOperation) then begin
- If TPCOperation.OperationToOperationResume(ABlock_number,LOpData,False,LOpData.SignerAccount,LOperationResume) then begin
- LOperationResume.Balance:=-1;
- LOperationResume.NOpInsideBlock:=LList.Items[i];
- LOperationResume.Block:=ABlock_number;
- AOperationsResumeList.Add(LOperationResume);
- end;
- end;
- inc(LFoundCounter);
+ if DoAddOpData(LOpData,LFoundCounter,LOperationResume) then begin
+ LOperationResume.NOpInsideBlock:=LList.Items[i];
+ LOperationResume.Block:=ABlock_number;
+ AOperationsResumeList.Add(LOperationResume);
+ LFound_in_block := True;
end;
end;
end; // For LList...
@@ -225,8 +268,12 @@ class function TRPCOpData.OpData_FindOpDataOperations(
begin
Result := False;
- LSender := AInputParams.AsCardinal('sender',CT_MaxAccount);
- LTarget := AInputParams.AsCardinal('target',CT_MaxAccount);
+ if Not TPascalCoinJSONComp.CaptureAccountNumber(AInputParams,'sender',ASender.Node,LSender,AErrorDesc) then begin
+ LSender := CT_MaxAccount;
+ end;
+ if Not TPascalCoinJSONComp.CaptureAccountNumber(AInputParams,'target',ASender.Node,LTarget,AErrorDesc) then begin
+ LTarget := CT_MaxAccount;
+ end;
LSearchedAccount_number := CT_MaxAccount;
LSearchBySender := (LSender>=0) And (LSender=0) And (LTarget=0 then begin
- LStartBlock := AInputParams.AsInteger('startblock',100);
+ LStartBlock := AInputParams.AsInteger('startblock',ASender.Node.Bank.BlocksCount);
LFirst_Block_Is_Unknown := True;
end else begin
if not ASender.RPCServer.GetMempoolAccount(LSearchedAccount_number,LAccount) then begin
@@ -277,14 +324,13 @@ class function TRPCOpData.OpData_FindOpDataOperations(
end;
LFirst_Block_Is_Unknown := False;
LStartBlock := LAccount.GetLastUpdatedBlock;
- if LStartBlock>=ASender.Node.Bank.BlocksCount then Dec(LStartBlock); // If its updated on mempool, don't look the mempool
end;
LOperationsResumeList := TOperationsResumeList.Create;
try
DoFindFromBlock(LStartBlock,
LSearchedAccount_number,
- LStartOperation, LStartOperation + LMaxOperations,
+ LStartOperation, LStartOperation + LMaxOperations - 1,
LMaxDepth, LFirst_Block_Is_Unknown,
LSearchBySender, LSender,
LSearchByTarget, LTarget,
@@ -297,7 +343,9 @@ class function TRPCOpData.OpData_FindOpDataOperations(
LResultArray := AJSONResponse.GetAsArray('result');
for i := 0 to LOperationsResumeList.Count-1 do begin
- TPascalCoinJSONComp.FillOperationObject(LOperationsResumeList.OperationResume[i],ASender.Node.Bank.BlocksCount,LResultArray.GetAsObject( LResultArray.Count ));
+ TPascalCoinJSONComp.FillOperationObject(LOperationsResumeList.Items[i],ASender.Node.Bank.BlocksCount,
+ ASender.Node,ASender.RPCServer.WalletKeys,ASender.RPCServer.PayloadPasswords,
+ LResultArray.GetAsObject( LResultArray.Count ));
end;
Result := True;
finally
@@ -313,28 +361,46 @@ class function TRPCOpData.OpData_SendOpData(const ASender: TRPCProcess;
LOperationPayload : TOperationPayload;
LErrors : String;
LOPR : TOperationResume;
+ LTargetEPASA : TEPasa;
+ LTargetKey : TAccountKey;
+ LTargetRequiresPurchase : Boolean;
begin
Result := False;
- if Not ASender.RPCServer.GetMempoolAccount(AInputParams.AsInteger('sender',CT_MaxAccount),LSender) then begin
+ ASender.Node.OperationSequenceLock.Acquire; // Use lock to prevent N_Operation race-condition on concurrent operations
+ try
+
+ if Not TPascalCoinJSONComp.CaptureMempoolAccount(AInputParams,'sender',ASender.Node,LSender,AErrorDesc) then begin
AErrorNum := CT_RPC_ErrNum_InvalidAccount;
- AErrorDesc := 'Invalid "sender"';
Exit;
end;
if (AInputParams.IndexOfName('signer')>=0) then begin
- if Not ASender.RPCServer.GetMempoolAccount(AInputParams.AsInteger('signer',CT_MaxAccount),LSigner) then begin
+ if Not TPascalCoinJSONComp.CaptureMempoolAccount(AInputParams,'signer',ASender.Node,LSigner,AErrorDesc) then begin
AErrorNum := CT_RPC_ErrNum_InvalidAccount;
- AErrorDesc := 'Invalid "signer"';
Exit;
end;
end else LSigner := LSender; // If no "signer" param, then use "sender" as signer by default
- if Not ASender.RPCServer.GetMempoolAccount(AInputParams.AsInteger('target',CT_MaxAccount),LTarget) then begin
+
+ LTarget := CT_Account_NUL;
+ if Not TPascalCoinJSONComp.CaptureEPASA(AInputParams,'target',ASender.Node, LTargetEPASA, LTarget.account, LTargetKey, LTargetRequiresPurchase, AErrorDesc) then begin
AErrorNum := CT_RPC_ErrNum_InvalidAccount;
- AErrorDesc := 'Invalid "target"';
- Exit;
+ Exit(False);
+ end else begin
+ LTarget := ASender.Node.GetMempoolAccount(LTarget.account);
+ if (LTargetRequiresPurchase) then begin
+ AErrorNum := CT_RPC_ErrNum_InvalidEPASA;
+ AErrorDesc := 'PayToKey not available as a EPasa format on this method';
+ Exit(False);
+ end;
+ end;
+ if Not TPascalCoinJSONComp.OverridePayloadParams(AInputParams, LTargetEPASA) then begin
+ AErrorNum := CT_RPC_ErrNum_AmbiguousPayload;
+ AErrorDesc := 'Target EPASA payload conflicts with argument payload.';
+ Exit(False);
end;
if not TPascalCoinJSONComp.CheckAndGetEncodedRAWPayload(
TCrypto.HexaToRaw(AInputParams.AsString('payload','')),
+ [ptNonDeterministic],
AInputParams.AsString('payload_method','none'),
AInputParams.AsString('pwd',''),
LSender.accountInfo.accountKey,
@@ -361,11 +427,17 @@ class function TRPCOpData.OpData_SendOpData(const ASender: TRPCProcess;
Exit;
end;
TPCOperation.OperationToOperationResume(0,LOpData,False,LSender.account,LOPR);
- TPascalCoinJSONComp.FillOperationObject(LOPR,ASender.Node.Bank.BlocksCount,AJSONResponse.GetAsObject('result'));
+ TPascalCoinJSONComp.FillOperationObject(LOPR,ASender.Node.Bank.BlocksCount,
+ ASender.Node,ASender.RPCServer.WalletKeys,ASender.RPCServer.PayloadPasswords,
+ AJSONResponse.GetAsObject('result'));
Result := True;
finally
LOpData.free;
end;
+
+ finally
+ ASender.Node.OperationSequenceLock.Release;
+ end;
end;
class function TRPCOpData.OpData_SignOpData(const ASender: TRPCProcess;
@@ -409,6 +481,7 @@ class function TRPCOpData.OpData_SignOpData(const ASender: TRPCProcess;
if not TPascalCoinJSONComp.CheckAndGetEncodedRAWPayload(
TCrypto.HexaToRaw(AInputParams.AsString('payload','')),
+ [ptNonDeterministic],
AInputParams.AsString('payload_method','dest'),
AInputParams.AsString('pwd',''),
LPayloadPubkey,
diff --git a/src/core/UPCRPCSend.pas b/src/core/UPCRPCSend.pas
new file mode 100644
index 000000000..51b832c43
--- /dev/null
+++ b/src/core/UPCRPCSend.pas
@@ -0,0 +1,362 @@
+unit UPCRPCSend;
+
+{ Copyright (c) 2021 by PascalCoin developers, orignal code by Albert Molina
+
+ Distributed under the MIT software license, see the accompanying file LICENSE
+ or visit http://www.opensource.org/licenses/mit-license.php.
+
+ This unit is a part of the PascalCoin Project, an infinitely scalable
+ cryptocurrency. Find us here:
+ Web: https://www.pascalcoin.org
+ Source: https://github.com/PascalCoin/PascalCoin
+
+ If you like it, consider a donation using Bitcoin:
+ 16K3HCZRhFUtM8GdWRcfKeaa6KsuyxZaYk
+
+ THIS LICENSE HEADER MUST NOT BE REMOVED.
+}
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+interface
+
+{$I ./../config.inc}
+
+Uses classes, SysUtils,
+ UJSONFunctions, UAccounts, UBaseTypes, UOpTransaction, UConst,
+ {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF},
+ URPC, UCrypto, UWallet, UBlockChain, UEPasa, ULog, UPCOrderedLists, UPCDataTypes;
+
+
+Type
+ TRPCSend = Class
+ private
+ public
+ class function CreateOperationTransaction(const ARPCProcess : TRPCProcess; ACurrentProtocol : Word; ASender, ATarget : TAccount; AAmount, AFee : UInt64; const ARawPayload : TRawBytes; const APayloadMethod, AEncodePwd : String; const APayloadType : TPayloadType; var AErrorNum: Integer; var AErrorDesc: String) : TOpTransaction;
+ class function CreatePayToKeyTransaction(const ARPCProcess : TRPCProcess; ACurrentProtocol: Word; ASender, APurchaseAccount : TAccount; const ANewKey : TAccountKey; AAmount, AFee: UInt64; const ARawPayload: TRawBytes; const APayloadMethod, AEncodePwd: String; const APayloadType : TPayloadType; var AErrorNum: Integer; var AErrorDesc: String) : TOpTransaction;
+ class function SendTo(const ASender : TRPCProcess; const AMethodName : String; AInputParams, AJSONResponse : TPCJSONObject; var AErrorNum : Integer; var AErrorDesc : String) : Boolean;
+ class function SignSendTo(const ASender : TRPCProcess; const AMethodName : String; AInputParams, AJSONResponse : TPCJSONObject; var AErrorNum : Integer; var AErrorDesc : String) : Boolean;
+ End;
+
+implementation
+
+{ TRPCSend }
+
+class function TRPCSend.CreateOperationTransaction(const ARPCProcess : TRPCProcess; ACurrentProtocol : Word; ASender, ATarget : TAccount; AAmount, AFee : UInt64; const ARawPayload : TRawBytes; const APayloadMethod, AEncodePwd : String; const APayloadType : TPayloadType; var AErrorNum: Integer; var AErrorDesc: String): TOpTransaction;
+var
+ LOpPayload : TOperationPayload;
+ LPrivateKey : TECPrivateKey;
+Begin
+ Result := Nil;
+ if Not ARPCProcess.RPCServer.CheckAndGetPrivateKeyInWallet(ASender.accountInfo.accountKey, LPrivateKey, AErrorNum, AErrorDesc) then Exit(Nil);
+ if Not TPascalCoinJSONComp.CheckAndGetEncodedRAWPayload(ARawPayload, APayloadType, APayloadMethod, AEncodePwd, ASender.accountInfo.accountKey, ATarget.accountInfo.accountKey, LOpPayload, AErrorNum, AErrorDesc) then Exit(Nil);
+ Result := TOpTransaction.CreateTransaction(ACurrentProtocol, ASender.account, ASender.n_operation+1, ATarget.account, LPrivateKey, AAmount, AFee, LOpPayload);
+ if Not Result.HasValidSignature then begin
+ FreeAndNil(Result);
+ AErrorNum:=CT_RPC_ErrNum_InternalError;
+ AErrorDesc:='Invalid signature';
+ exit;
+ end;
+end;
+
+class function TRPCSend.CreatePayToKeyTransaction(const ARPCProcess : TRPCProcess; ACurrentProtocol: Word; ASender, APurchaseAccount : TAccount; const ANewKey : TAccountKey; AAmount, AFee: UInt64; const ARawPayload: TRawBytes; const APayloadMethod, AEncodePwd: String; const APayloadType : TPayloadType; var AErrorNum: Integer; var AErrorDesc: String): TOpTransaction;
+Var
+ LOpPayload : TOperationPayload;
+ LPrivateKey : TECPrivateKey;
+Begin
+ Result := Nil;
+ if (AAmount < APurchaseAccount.accountInfo.price) then begin
+ AErrorNum := CT_RPC_ErrNum_InternalError;
+ AErrorDesc := 'Insufficient funds to purchase account for pay-to-key transaction';
+ Exit(Nil);
+ end;
+
+ if Not ARPCProcess.RPCServer.CheckAndGetPrivateKeyInWallet(ASender.accountInfo.accountKey, LPrivateKey, AErrorNum, AErrorDesc) then Exit(Nil);
+ if Not TPascalCoinJSONComp.CheckAndGetEncodedRAWPayload(ARawPayload, APayloadType, APayloadMethod, AEncodePwd, ASender.accountInfo.accountKey, ANewKey, LOpPayload, AErrorNum, AErrorDesc) then Exit(Nil);
+ Result := TOpBuyAccount.CreateBuy(ACurrentProtocol, ASender.account, ASender.n_operation + 1, APurchaseAccount.account, APurchaseAccount.accountInfo.account_to_pay, APurchaseAccount.accountInfo.price, AAmount, AFee, ANewKey, LPrivateKey, LOpPayload);
+ if Not Result.HasValidSignature then begin
+ FreeAndNil(Result);
+ AErrorNum:=CT_RPC_ErrNum_InternalError;
+ AErrorDesc:='Invalid signature';
+ exit;
+ end;
+end;
+
+class function TRPCSend.SendTo(const ASender: TRPCProcess;
+ const AMethodName: String; AInputParams, AJSONResponse: TPCJSONObject;
+ var AErrorNum: Integer; var AErrorDesc: String): Boolean;
+
+{ JSON-RPC "sendto"
+
+### sendto
+Executes a transaction operation from "sender" to "target"
+
+##### Params
+- `sender` : Integer - Sender account
+- `target` : Integer - Destination account
+- `amount` : PASCURRENCY - Coins to be transferred
+- `fee` : PASCURRENCY - Fee of the operation
+- `payload` : HEXASTRING - Payload "item" that will be included in this operation
+- `payload_method` : String - Encode type of the item payload
+ - `none` : Not encoded. Will be visible for everybody
+ - `dest` (default) : Using Public key of "target" account. Only "target" will be able to decrypt this payload
+ - `sender` : Using sender Public key. Only "sender" will be able to decrypt this payload
+ - `aes` : Encrypted data using `pwd` param
+- `pwd` : String - Used to encrypt payload with `aes` as a `payload_method`. If none equals to empty password
+
+##### Result
+If transaction is successfull will return a JSON Object in "[Operation Object]" format.
+Otherwise, will return a JSON-RPC error code with description
+
+}
+
+var
+ LSender, LTarget : TAccount;
+ LTargetEPASA : TEPasa;
+ LTargetKey : TAccountKey;
+ LTargetRequiresPurchase : Boolean;
+ LAmount, LFee : UInt64;
+ LRawPayload : TRawBytes;
+ LPayload_method, LEncodePwd, LErrors : String;
+ LOpt : TOpTransaction;
+ LOpr : TOperationResume;
+ LTmpTarget : Cardinal;
+begin
+ // Get Parameters
+ Result := False;
+
+ if (Not ASender.RPCServer.AllowUsePrivateKeys) then begin
+ // Protection when server is locked to avoid private keys call
+ AErrorNum := CT_RPC_ErrNum_NotAllowedCall;
+ Exit;
+ end;
+ If Not ASender.RPCServer.WalletKeys.IsValidPassword then begin
+ AErrorNum := CT_RPC_ErrNum_WalletPasswordProtected;
+ AErrorDesc := 'Wallet is password protected. Unlock first';
+ exit;
+ end;
+
+ // Do new operation
+ ASender.Node.OperationSequenceLock.Acquire; // Use lock to prevent N_Operation race-condition on concurrent sends
+ try
+
+ if Not TPascalCoinJSONComp.CaptureAccountNumber(AInputParams,'sender',ASender.Node,LSender.account,AErrorDesc) then begin
+ AErrorNum := CT_RPC_ErrNum_InvalidAccount;
+ Exit;
+ end else LSender := ASender.Node.GetMempoolAccount(LSender.account);
+
+ LTarget := CT_Account_NUL;
+ if Not TPascalCoinJSONComp.CaptureEPASA(AInputParams,'target',ASender.Node, LTargetEPASA, LTarget.account, LTargetKey, LTargetRequiresPurchase, AErrorDesc) then begin
+ AErrorNum := CT_RPC_ErrNum_InvalidAccount;
+ Exit;
+ end else LTarget := ASender.Node.GetMempoolAccount(LTarget.account);
+
+ if (LTargetEPASA.PayloadType.ToProtocolValue=0) and ((LTarget.account=0) or (LTarget.account=LSender.account)) then begin
+ // Try to decode from payload
+ // String payload:
+ if TPascalCoinJSONComp.CaptureEPASA(AInputParams,'payload',ASender.Node, LTargetEPASA, LTmpTarget, LTargetKey, LTargetRequiresPurchase, AErrorDesc) then begin
+ if LTargetRequiresPurchase then begin
+ AInputParams.GetAsVariant('payload').Value := LTargetEPASA.GetRawPayloadBytes.ToHexaString;
+ LTarget := ASender.Node.GetMempoolAccount(LTmpTarget);
+ end;
+ end;
+ if (Not LTargetRequiresPurchase) then begin
+ // HEXASTRING payload:
+ if (TPascalCoinJSONComp.CaptureEPASA(TCrypto.HexaToRaw(AInputParams.AsString('payload','')).ToPrintable, ASender.Node, LTargetEPASA, LTmpTarget, LTargetKey, LTargetRequiresPurchase, AErrorDesc)) then begin
+ if LTargetRequiresPurchase then begin
+ AInputParams.GetAsVariant('payload').Value := LTargetEPASA.GetRawPayloadBytes.ToHexaString;
+ LTarget := ASender.Node.GetMempoolAccount(LTmpTarget);
+ end;
+ end;
+ end;
+ end;
+
+ if Not TPascalCoinJSONComp.OverridePayloadParams(AInputParams, LTargetEPASA) then begin
+ AErrorNum := CT_RPC_ErrNum_AmbiguousPayload;
+ AErrorDesc := 'Target EPASA payload conflicts with argument payload.';
+ Exit;
+ end;
+
+ LAmount := TPascalCoinJSONComp.ToPascalCoins(AInputParams.AsDouble('amount',0));
+ LFee := TPascalCoinJSONComp.ToPascalCoins(AInputParams.AsDouble('fee',0));
+ LRawPayload := TCrypto.HexaToRaw(AInputParams.AsString('payload',''));
+ LPayload_method := AInputParams.AsString('payload_method','dest');
+ LEncodePwd := AInputParams.AsString('pwd','');
+
+ // Create operation
+ if LTargetRequiresPurchase then begin
+ // Buy Account
+ LOpt := CreatePayToKeyTransaction(
+ ASender, ASender.Node.Bank.SafeBox.CurrentProtocol,
+ LSender, LTarget, LTargetKey, LAmount, LFee,
+ LRawPayload, LPayload_method, LEncodePwd, LTargetEPASA.PayloadType,
+ AErrorNum, AErrorDesc);
+ end else begin
+ // Transaction
+ LOpt := CreateOperationTransaction(
+ ASender, ASender.Node.Bank.SafeBox.CurrentProtocol,
+ LSender, LTarget, LAmount, LFee,
+ LRawPayload, LPayload_method, LEncodePwd, LTargetEPASA.PayloadType,
+ AErrorNum, AErrorDesc);
+ end;
+ // Execute operation
+ if Assigned(LOpt) then
+ try
+ If not ASender.Node.AddOperation(Nil,LOpt,LErrors) then begin
+ AErrorDesc := 'Error adding operation: '+LErrors;
+ AErrorNum := CT_RPC_ErrNum_InvalidOperation;
+ Exit;
+ end;
+ TPCOperation.OperationToOperationResume(0,LOpt,False,LSender.account,LOpr);
+ TPascalCoinJSONComp.FillOperationObject(LOpr,ASender.Node.Bank.BlocksCount,
+ ASender.Node,ASender.RPCServer.WalletKeys,ASender.RPCServer.PayloadPasswords,
+ AJSONResponse.GetAsObject('result'));
+ Result := true;
+ finally
+ LOpt.free;
+ end;
+ finally
+ ASender.Node.OperationSequenceLock.Release;
+ end;
+end;
+
+class function TRPCSend.SignSendTo(const ASender: TRPCProcess;
+ const AMethodName: String; AInputParams, AJSONResponse: TPCJSONObject;
+ var AErrorNum: Integer; var AErrorDesc: String): Boolean;
+
+{ JSON-RPC "signsendto"
+
+### signsendto
+
+Creates and signs a "Send to" operation without checking information and without transfering to the network.
+It's usefull for "cold wallets" that are off-line (not synchronized with the network) and only holds private keys
+
+##### Params
+- `rawoperations` : HEXASTRING (optional) - If we want to add a sign operation with other previous operations, here we must put previous `rawoperations` result
+- `sender` : Integer - Sender account
+- `target` : Integer - Target account
+- `sender_enc_pubkey` or `sender_b58_pubkey` : HEXASTRING - Public key (in encoded format or b58 format) of the sender account
+- `target_enc_pubkey` or `target_b58_pubkey` : HEXASTRING - Public key (in encoded format or b58 format) of the target account
+- `last_n_operation` : Last value of `n_operation` obtained with an [Account object](#account-object), for example when called to [getaccount](#getaccount)
+- `amount`,`fee`,`payload`,`payload_method`,`pwd` : Same values that calling [sendto](#sendto)
+
+##### Result
+
+Wallet must be unlocked and sender private key (searched with provided public key) must be in wallet.
+No other checks are made (no checks for valid target, valid n_operation, valid amount or fee ...)
+Returns a [Raw Operations Object](#raw-operations-object)
+
+}
+var
+ LSender, LTarget : TAccount;
+ LTargetEPASA : TEPasa;
+ LTargetKey : TAccountKey;
+ LTargetRequiresPurchase : Boolean;
+ LHexaStringOperationsHashTree, LErrors : String;
+ LProtocol : Integer;
+ LOperationsHashTree : TOperationsHashTree;
+ LOpt : TOpTransaction;
+ LOpr : TOperationResume;
+ LRawPayload : TRawBytes;
+ LPayload_method, LEncodePwd : String;
+ LAmount, LFee : UInt64;
+begin
+ Result := False;
+
+ if (Not ASender.RPCServer.AllowUsePrivateKeys) then begin
+ // Protection when server is locked to avoid private keys call
+ AErrorNum := CT_RPC_ErrNum_NotAllowedCall;
+ Exit;
+ end;
+ If Not ASender.RPCServer.WalletKeys.IsValidPassword then begin
+ AErrorNum := CT_RPC_ErrNum_WalletPasswordProtected;
+ AErrorDesc := 'Wallet is password protected. Unlock first';
+ exit;
+ end;
+ if Not TPascalCoinJSONComp.CaptureAccountNumber(AInputParams,'sender',Nil,LSender.account,AErrorDesc) then begin
+ AErrorNum := CT_RPC_ErrNum_InvalidAccount;
+ Exit;
+ end;
+ if Not TPascalCoinJSONComp.CaptureNOperation(AInputParams,'last_n_operation',Nil,LSender.n_operation,AErrorDesc) then begin
+ AErrorNum := CT_RPC_ErrNum_InvalidAccount;
+ Exit;
+ end;
+
+ if Not TPascalCoinJSONComp.CaptureEPASA(AInputParams,'target', nil, LTargetEPASA, LTarget.account, LTargetKey, LTargetRequiresPurchase, AErrorDesc) then begin
+ AErrorNum := CT_RPC_ErrNum_InvalidEPASA;
+ Exit;
+ end;
+
+ if Not TPascalCoinJSONComp.OverridePayloadParams(AInputParams, LTargetEPASA) then begin
+ AErrorNum := CT_RPC_ErrNum_AmbiguousPayload;
+ Exit;
+ end;
+
+ If Not TPascalCoinJSONComp.CapturePubKey(AInputParams,'sender_',LSender.accountInfo.accountKey,AErrorDesc) then begin
+ AErrorNum := CT_RPC_ErrNum_InvalidPubKey;
+ exit;
+ end;
+
+ If Not TPascalCoinJSONComp.CapturePubKey(AInputParams,'target_',LTarget.accountInfo.accountKey,AErrorDesc) then begin
+ AErrorNum := CT_RPC_ErrNum_InvalidPubKey;
+ exit;
+ end;
+
+ LAmount := TPascalCoinJSONComp.ToPascalCoins(AInputParams.AsDouble('amount',0));
+ LFee := TPascalCoinJSONComp.ToPascalCoins(AInputParams.AsDouble('fee',0));
+ LRawPayload := TCrypto.HexaToRaw(AInputParams.AsString('payload',''));
+ LPayload_method := AInputParams.AsString('payload_method','dest');
+ LEncodePwd := AInputParams.AsString('pwd','');
+
+ LHexaStringOperationsHashTree := AInputParams.AsString('rawoperations','');
+ LProtocol := AInputParams.AsCardinal('protocol',CT_BUILD_PROTOCOL);
+
+ if Not TPascalCoinJSONComp.HexaStringToOperationsHashTree(LHexaStringOperationsHashTree,LProtocol,LOperationsHashTree,LErrors) then begin
+ AErrorNum:=CT_RPC_ErrNum_InvalidData;
+ AErrorDesc:= 'Error decoding param "rawoperations": '+LErrors;
+ Exit;
+ end;
+
+
+ Try
+ // Create operation
+ if LTargetRequiresPurchase then begin
+ // Buy Account
+ LOpt := CreatePayToKeyTransaction(
+ ASender, ASender.Node.Bank.SafeBox.CurrentProtocol,
+ LSender, LTarget, LTargetKey, LAmount, LFee,
+ LRawPayload, LPayload_method, LEncodePwd, LTargetEPASA.PayloadType,
+ AErrorNum, AErrorDesc);
+ end else begin
+ // Transaction
+ LOpt := CreateOperationTransaction(
+ ASender, ASender.Node.Bank.SafeBox.CurrentProtocol,
+ LSender, LTarget, LAmount, LFee,
+ LRawPayload, LPayload_method, LEncodePwd, LTargetEPASA.PayloadType,
+ AErrorNum, AErrorDesc);
+ end;
+
+ // Execute operation
+ if Assigned(LOpt) then
+ try
+ LOperationsHashTree.AddOperationToHashTree(LOpt);
+ TPascalCoinJSONComp.FillOperationsHashTreeObject(LOperationsHashTree,AJSONResponse.GetAsObject('result'));
+ Result := true;
+ finally
+ LOpt.Free;
+ end;
+
+ Finally
+ LOperationsHashTree.Free;
+ End;
+end;
+
+initialization
+ TRPCProcess.RegisterProcessMethod('signsendto',TRPCSend.SignSendTo);
+ TRPCProcess.RegisterProcessMethod('sendto',TRPCSend.SendTo);
+finalization
+ TRPCProcess.UnregisterProcessMethod('signsendto');
+ TRPCProcess.UnregisterProcessMethod('sendto');
+end.
diff --git a/src/core/UPCSafeBoxRootHash.pas b/src/core/UPCSafeBoxRootHash.pas
index f12477739..c48da7d05 100644
--- a/src/core/UPCSafeBoxRootHash.pas
+++ b/src/core/UPCSafeBoxRootHash.pas
@@ -428,7 +428,7 @@ procedure TBytesBuffer32Safebox.NotifyUpdated(AStartPos, ACountBytes: Integer);
FreeAndNil(FNextLevelBytesBuffer);
end else if Not Assigned(FNextLevelBytesBuffer) then begin
// First time must "Redo"
- RedoNextLevelsForMerkleRootHash;
+ // "RedoNextLevelsForMerkleRootHash" will be called when need to access next level value
end else begin
LLevelItemIndex := AStartPos DIV 32;
LLevelItemsCount := Self.Length DIV 32;
diff --git a/src/core/UPCTNetDataExtraMessages.pas b/src/core/UPCTNetDataExtraMessages.pas
index ac535179b..db8835ff3 100644
--- a/src/core/UPCTNetDataExtraMessages.pas
+++ b/src/core/UPCTNetDataExtraMessages.pas
@@ -33,7 +33,7 @@ interface
{$ENDIF}
Uses Classes, UThread, UAccounts, UBlockChain, UNetProtocol, SysUtils, UNode,
- UWallet, UNetProtection, UPCDataTypes,
+ UWallet, UNetProtection, UPCDataTypes, UPCAccountsOrdenations, UOrderedList,
{$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF};
type
@@ -42,9 +42,9 @@ interface
FNode : TNode;
FNetData : TNetData;
FWalletKeys : TWalletKeysExt;
- function DoAskForFreeAccount(ANewPubliKey : TAccountKey) : Integer;
- {$IFDEF TESTNET}
+ function DoAskForFreeAccount(const ANewPubliKey : TAccountKey; const AMessage : String) : Integer;
procedure DoGiveMeAnAccount(ANetData : TNetData; ASenderConnection : TNetConnection; const AHeaderData : TNetHeaderData; AReceivedData : TStream; AResponseData : TStream);
+ {$IFDEF TESTNET}
procedure DoGiveMeMoney(ANetData : TNetData; ASenderConnection : TNetConnection; const AHeaderData : TNetHeaderData; AReceivedData : TStream; AResponseData : TStream);
{$ENDIF}
procedure OnTNetDataProcessReservedAreaMessage(ANetData : TNetData; ASenderConnection : TNetConnection; const AHeaderData : TNetHeaderData; AReceivedData : TStream; AResponseData : TStream);
@@ -54,7 +54,7 @@ interface
class function InitNetDataExtraMessages(ANode : TNode; ANetData : TNetData; AWalletKeys : TWalletKeysExt) : TPCTNetDataExtraMessages;
constructor Create(ANode : TNode; ANetData : TNetData; AWalletKeys : TWalletKeysExt);
destructor Destroy; override;
- class function AskForFreeAccount(ANewPubliKey : TAccountKey) : Integer;
+ class function AskForFreeAccount(const ANewPubliKey : TAccountKey; const AMessage : String): Integer;
End;
const
@@ -63,16 +63,16 @@ interface
implementation
-Uses UOpTransaction, UBaseTypes, ULog;
+Uses UOpTransaction, UBaseTypes, ULog, UPCAbstractMemAccountKeys;
var _PCTNetDataExtraMessages : TPCTNetDataExtraMessages = Nil;
{ TPCTNetDataExtraMessages }
-class function TPCTNetDataExtraMessages.AskForFreeAccount(ANewPubliKey : TAccountKey): Integer;
+class function TPCTNetDataExtraMessages.AskForFreeAccount(const ANewPubliKey : TAccountKey; const AMessage : String): Integer;
begin
if Assigned(_PCTNetDataExtraMessages) then begin
- Result := _PCTNetDataExtraMessages.DoAskForFreeAccount(ANewPubliKey);
+ Result := _PCTNetDataExtraMessages.DoAskForFreeAccount(ANewPubliKey,AMessage);
end else Result := 0;
end;
@@ -98,15 +98,18 @@ destructor TPCTNetDataExtraMessages.Destroy;
inherited;
end;
-function TPCTNetDataExtraMessages.DoAskForFreeAccount(ANewPubliKey : TAccountKey): Integer;
+function TPCTNetDataExtraMessages.DoAskForFreeAccount(const ANewPubliKey : TAccountKey; const AMessage : String): Integer;
var i : Integer;
LNetConnection : TNetConnection;
LRequestStream : TMemoryStream;
+ Lraw : TRawBytes;
begin
Result := 0;
LRequestStream := TMemoryStream.Create;
try
TStreamOp.WriteAccountKey(LRequestStream,ANewPubliKey);
+ Lraw.FromString(AMessage);
+ TStreamOp.WriteAnsiString(LRequestStream,Lraw);
LRequestStream.position := 0;
for i := 0 to FNetData.ConnectionsCountAll-1 do begin
LNetConnection := FNetData.Connection(i);
@@ -126,42 +129,76 @@ function TPCTNetDataExtraMessages.DoAskForFreeAccount(ANewPubliKey : TAccountKey
end;
end;
-{$IFDEF TESTNET}
procedure TPCTNetDataExtraMessages.DoGiveMeAnAccount(ANetData: TNetData;
ASenderConnection: TNetConnection; const AHeaderData: TNetHeaderData;
AReceivedData, AResponseData: TStream);
var LSenderPublicKey : TAccountKey;
- LIndexKey : Integer;
+ LIndexKey,LOnSafebox,LOnMempool : Integer;
LAccount : TAccount;
- LOpChangeKey : TOpChangeKey;
+ LOpRecoverFounds : TOpRecoverFounds;
LPayload : TOperationPayload;
- LErrors : String;
+ LErrors, LSenderMessage : String;
LWord : Word;
+ LAccOrd : TAccountsOrderedByUpdatedBlock;
+ LRaw : TRawBytes;
begin
if Not (AHeaderData.header_type in [ntp_request,ntp_autosend]) then Exit; // Nothing to do
// Protection to allow spam
- if ANetData.IpInfos.Update_And_ReachesLimits(ASenderConnection.Client.RemoteHost,'EXTRA','GIVE_ME_AN_ACCOUNT',AHeaderData.buffer_data_length,True,
+ if ANetData.IpInfos.Update_And_ReachesLimits(ASenderConnection.Client.RemoteHost,'EXTRA','GIVE_ME_AN_ACCOUNT',
+ AHeaderData.buffer_data_length,True,
TArray.Create(TLimitLifetime.Create(300,2,20000))) then Exit;
// Read info
if TStreamOp.ReadAccountKey(AReceivedData,LSenderPublicKey)<=0 then Exit;
- if Not RandomGetWalletKeysAccount(FNode.Bank.SafeBox,FWalletKeys,0,10000,LIndexKey,LAccount) then Exit;
- // Send
- LPayload := CT_TOperationPayload_NUL;
- LPayload.payload_raw.FromString('Free Account to '+ASenderConnection.Client.RemoteHost);
- LOpChangeKey := TOpChangeKey.Create(FNode.Bank.SafeBox.CurrentProtocol,LAccount.account,LAccount.n_operation+1,
- LAccount.account,FWalletKeys.Key[LIndexKey].PrivateKey,LSenderPublicKey,0,LPayload);
+ if TStreamOp.ReadString(AReceivedData,LSenderMessage)<0 then Exit;
+
+ if FNode.GetAccountsAvailableByPublicKey(LSenderPublicKey,LOnSafebox,LOnMempool)>0 then begin
+ // Exit;
+ TLog.NewLog(ltdebug,ClassName,Format('Not Sending to %s because PublicKey %s is used %d and mempool %d',[ASenderConnection.Client.RemoteHost,
+ TAccountComp.AccountPublicKeyExport(LSenderPublicKey),LOnSafebox,LOnMempool]));
+ Lword := 0;
+ AResponseData.Write(Lword,2);
+ Exit;
+ end;
+
+ LAccOrd := FNode.Bank.SafeBox.AccountsOrderedByUpdatedBlock;
+ if Assigned(LAccOrd) then begin
+ LAccount := CT_Account_NUL;
+ if LAccOrd.First(LIndexKey) then begin
+ LAccount := FNode.GetMempoolAccount(LIndexKey);
+ while (Random(100)>0) or (LAccount.balance>0) or (Length(LAccount.name)>0) do begin
+ if Not LAccOrd.Next(LIndexKey) then Exit;
+ LAccount := FNode.GetMempoolAccount(LIndexKey);
+ end;
+ end;
+ //
+ end;
+
+ TLog.NewLog(ltdebug,ClassName,Format('Sending to %s Account %s PublicKey %s',
+ [ASenderConnection.Client.RemoteHost,
+ TAccountComp.AccountNumberToAccountTxtNumber(LAccount.account),
+ TAccountComp.AccountPublicKeyExport(LSenderPublicKey)]));
+
+ LOpRecoverFounds := TOpRecoverFounds.Create(FNode.Bank.SafeBox.CurrentProtocol,LAccount.account,LAccount.n_operation+1,0,LSenderPublicKey);
try
- FNode.AddOperation(Nil,LOpChangeKey,LErrors);
+ if FNode.AddOperation(Nil,LOpRecoverFounds,LErrors) then begin
+ Lword := 1;
+ AResponseData.Write(Lword,2);
+ LRaw := LOpRecoverFounds.OperationHashValid(LOpRecoverFounds,0);
+ TStreamOp.WriteAnsiString(AResponseData,LRaw);
+ end else begin
+ Lword := 0;
+ AResponseData.Write(Lword,2);
+ TLog.NewLog(ltdebug,ClassName,Format('Error %s sending to %s Account %s PublicKey %s',
+ [LErrors, ASenderConnection.Client.RemoteHost,
+ TAccountComp.AccountNumberToAccountTxtNumber(LAccount.account),
+ TAccountComp.AccountPublicKeyExport(LSenderPublicKey)]));
+ end;
finally
- LOpChangeKey.Free;
+ LOpRecoverFounds.Free;
end;
- // Response
- TStreamOp.WriteAccountKey(AResponseData,LSenderPublicKey);
- LWord := 1;
- AResponseData.Write(LWord,SizeOf(LWord));
- AResponseData.Write(LAccount.account,SizeOf(LAccount.account));
end;
+{$IFDEF TESTNET}
procedure TPCTNetDataExtraMessages.DoGiveMeMoney(ANetData: TNetData;
ASenderConnection: TNetConnection; const AHeaderData: TNetHeaderData;
AReceivedData, AResponseData: TStream);
@@ -207,6 +244,7 @@ class function TPCTNetDataExtraMessages.InitNetDataExtraMessages(ANode: TNode;
ANetData: TNetData; AWalletKeys: TWalletKeysExt): TPCTNetDataExtraMessages;
begin
if not Assigned(_PCTNetDataExtraMessages) then begin
+ TLog.NewLog(ltinfo,ClassName,'InitNetDataExtraMessages');
_PCTNetDataExtraMessages := TPCTNetDataExtraMessages.Create(ANode,ANetData,AWalletKeys);
end;
Result := _PCTNetDataExtraMessages;
@@ -215,12 +253,12 @@ class function TPCTNetDataExtraMessages.InitNetDataExtraMessages(ANode: TNode;
procedure TPCTNetDataExtraMessages.OnTNetDataProcessReservedAreaMessage(ANetData : TNetData; ASenderConnection : TNetConnection; const AHeaderData : TNetHeaderData; AReceivedData : TStream; AResponseData : TStream);
begin
TLog.NewLog(ltdebug,ClassName,Format('Received extra message from %s Operation:%d',[ASenderConnection.ClientRemoteAddr,AHeaderData.operation]));
- {$IFDEF TESTNET}
case AHeaderData.operation of
CT_NetProtocol_Extra_NetOp_GIVE_ME_AN_ACCOUNT : DoGiveMeAnAccount(ANetData,ASenderConnection,AHeaderData,AReceivedData,AResponseData);
+ {$IFDEF TESTNET}
CT_NetProtocol_Extra_NetOp_GIVE_ME_MONEY : DoGiveMeMoney(ANetData,ASenderConnection,AHeaderData,AReceivedData,AResponseData);
+ {$ENDIF}
end;
- {$ENDIF}
end;
function TPCTNetDataExtraMessages.RandomGetWalletKeysAccount(
diff --git a/src/core/UPCTemporalAbstractMem.pas b/src/core/UPCTemporalAbstractMem.pas
new file mode 100644
index 000000000..1d850ec31
--- /dev/null
+++ b/src/core/UPCTemporalAbstractMem.pas
@@ -0,0 +1,78 @@
+unit UPCTemporalAbstractMem;
+
+{ Copyright (c) 2016-2021 by Albert Molina
+
+ Distributed under the MIT software license, see the accompanying file LICENSE
+ or visit http://www.opensource.org/licenses/mit-license.php.
+
+ This unit is a part of the PascalCoin Project, an infinitely scalable
+ cryptocurrency. Find us here:
+ Web: https://www.pascalcoin.org
+ Source: https://github.com/PascalCoin/PascalCoin
+
+ If you like it, consider a donation using Bitcoin:
+ 16K3HCZRhFUtM8GdWRcfKeaa6KsuyxZaYk
+
+ THIS LICENSE HEADER MUST NOT BE REMOVED.
+}
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+interface
+
+{$I ./../config.inc}
+
+uses
+ Classes, {$IFnDEF FPC}Windows,{$ENDIF} SysUtils,
+ UPCTemporalFileStream,
+ UAbstractMem, UFileMem;
+
+Type
+ { TPCTemporalAbstractMem }
+
+ TPCTemporalAbstractMem = Class({$IFDEF USE_ABSTRACTMEM}TFileMem{$ELSE}TMem{$ENDIF})
+ private
+ {$IFDEF USE_ABSTRACTMEM}
+ FTemporalFileName : String;
+ {$ENDIF}
+ protected
+ public
+ Constructor Create; reintroduce;
+ Destructor Destroy; override;
+ End;
+
+implementation
+
+Uses {$IFDEF HIGHLOG}ULog, {$ENDIF} UNode;
+
+{ TPCTemporalFileStream }
+
+constructor TPCTemporalAbstractMem.Create;
+begin
+ {$IFDEF USE_ABSTRACTMEM}
+ FTemporalFileName := TPCTemporalFileStream.GetTemporalFileName('ABSTRACTMEM');
+ {$IFDEF HIGHLOG}TLog.NewLog(ltdebug,ClassName,Format('Creating a new Temporal AbstractMem file: %s',[FTemporalFileName]));{$ENDIF}
+ inherited Create(FTemporalFileName,False);
+ {$ELSE}
+ inherited Create(0,False);
+ {$ENDIF}
+end;
+
+destructor TPCTemporalAbstractMem.Destroy;
+{$IFDEF HIGHLOG}var LSize : Int64;{$ENDIF}
+begin
+ {$IFDEF HIGHLOG}
+ LSize := {$IFDEF USE_ABSTRACTMEM}NextAvailablePos{$ELSE}Size{$ENDIF};
+ {$ENDIF}
+ inherited Destroy;
+ {$IFDEF USE_ABSTRACTMEM}
+ if FTemporalFileName<>'' then begin
+ {$IFDEF HIGHLOG}TLog.NewLog(ltdebug,ClassName,Format('Deleting a Temporal AbstractMem file (%d bytes): %s',[LSize, FTemporalFileName]));{$ENDIF}
+ DeleteFile(FTemporalFileName);
+ end;
+ {$ENDIF}
+end;
+
+end.
diff --git a/src/core/UPCTemporalFileStream.pas b/src/core/UPCTemporalFileStream.pas
index 812ae623a..9a3419704 100644
--- a/src/core/UPCTemporalFileStream.pas
+++ b/src/core/UPCTemporalFileStream.pas
@@ -41,7 +41,7 @@ interface
implementation
-Uses ULog, UNode;
+Uses {$IFDEF HIGHLOG}ULog, {$ENDIF} UNode;
{ TPCTemporalFileStream }
@@ -63,18 +63,18 @@ constructor TPCTemporalFileStream.Create(const AInitialName : String);
end;
inc(i);
until (Not (FileExists(LFileName)) or (i>5000));
- TLog.NewLog(ltdebug,ClassName,Format('Creating a new Temporal file Stream: %s',[LFileName]));
+ {$IFDEF HIGHLOG}TLog.NewLog(ltdebug,ClassName,Format('Creating a new Temporal file Stream: %s',[LFileName]));{$ENDIF}
inherited Create(LFileName,fmCreate+fmShareDenyWrite);
FTemporalFileName:=LFileName;
end;
destructor TPCTemporalFileStream.Destroy;
-var LSize : Integer;
+{$IFDEF HIGHLOG}var LSize : Integer;{$ENDIF}
begin
- LSize := Size;
+ {$IFDEF HIGHLOG}LSize := Size;{$ENDIF}
inherited Destroy;
if FTemporalFileName<>'' then begin
- TLog.NewLog(ltdebug,ClassName,Format('Deleting a Temporal file Stream (%d bytes): %s',[LSize, FTemporalFileName]));
+ {$IFDEF HIGHLOG}TLog.NewLog(ltdebug,ClassName,Format('Deleting a Temporal file Stream (%d bytes): %s',[LSize, FTemporalFileName]));{$ENDIF}
DeleteFile(FTemporalFileName);
end;
end;
diff --git a/src/core/UPoolMinerThreads.pas b/src/core/UPoolMinerThreads.pas
index 584fbd7b1..f8526bf10 100644
--- a/src/core/UPoolMinerThreads.pas
+++ b/src/core/UPoolMinerThreads.pas
@@ -36,10 +36,11 @@ interface
WorkingMillisecondsTotal : Cardinal;
WinsCount : Integer;
Invalids : Integer;
+ InternalComputingRounds : Integer;
End;
Const
- CT_TMinerStats_NULL : TMinerStats = (Miners:0;RoundsCount:0;WorkingMillisecondsHashing:0;WorkingMillisecondsTotal:0;WinsCount:0;Invalids:0);
+ CT_TMinerStats_NULL : TMinerStats = (Miners:0;RoundsCount:0;WorkingMillisecondsHashing:0;WorkingMillisecondsTotal:0;WinsCount:0;Invalids:0;InternalComputingRounds:0);
Type
@@ -626,11 +627,6 @@ procedure TCustomMinerDeviceThread.SetPaused(AValue: Boolean);
end;
procedure TCustomMinerDeviceThread.UpdateDeviceStats(Stats: TMinerStats);
-Type TTimeMinerStats = Record
- tc : Cardinal;
- stats : TMinerStats;
- end;
- PTimeMinerStats = ^TTimeMinerStats;
Var l : TList;
i : Integer;
P : PTimeMinerStats;
@@ -657,6 +653,7 @@ procedure TCustomMinerDeviceThread.UpdateDeviceStats(Stats: TMinerStats);
if ((stats.Miners>foundMaxMiners)) then foundMaxMiners := stats.Miners;
end;
end;
+ FPartialDeviceStats.InternalComputingRounds:=l.count;
If l.count>0 then begin
P := PTimeMinerStats(l[l.count-1]);
FPartialDeviceStats.WorkingMillisecondsHashing:=P^.tc - PTimeMinerStats(l[0]).tc + P^.stats.WorkingMillisecondsHashing;
@@ -863,7 +860,7 @@ TNonceResult = record
if FCurrentMinerValuesForWork.version < CT_PROTOCOL_5 then
roundsToDo := 20
else
- roundsToDo := 200+Random(200);
+ roundsToDo := 100+Random(100);
end else begin
roundsToDo := 10000;
end;
@@ -982,6 +979,7 @@ TNonceResult = record
finalHashingTC:=TPlatform.GetTickCount;
end;
AuxStats.Miners:=FCPUDeviceThread.FCPUs;
+ AuxStats.InternalComputingRounds:=roundsToDo;
AuxStats.RoundsCount:=LRoundsPerformed;
AuxStats.WorkingMillisecondsTotal:=TPlatform.GetTickCount - baseRealTC;
AuxStats.WorkingMillisecondsHashing:= finalHashingTC - baseHashingTC;
diff --git a/src/core/UPoolMining.pas b/src/core/UPoolMining.pas
index b1d98f9d8..970e99405 100644
--- a/src/core/UPoolMining.pas
+++ b/src/core/UPoolMining.pas
@@ -31,7 +31,8 @@ interface
{LCLIntf, LCLType, LMessages,}
{$ENDIF}
UTCPIP, SysUtils, UThread, SyncObjs, Classes, UJSONFunctions, UPCEncryption, UNode,
- UCrypto, UAccounts, UConst, UBlockChain, UBaseTypes, UPCDataTypes,
+ UCrypto, UAccounts, UConst, UBlockChain, UBaseTypes, UPCDataTypes, UOpTransaction,
+ UPCAccountsOrdenations,
{$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF};
Const
@@ -140,6 +141,8 @@ TMinerValuesForWork_HELPER = record helper for TMinerValuesForWork
End;
+ { TPoolMiningServer }
+
TPoolMiningServer = Class(TNetTcpIpServer)
private
FIncomingsCounter : Integer;
@@ -154,6 +157,7 @@ TMinerValuesForWork_HELPER = record helper for TMinerValuesForWork
FMinerOperations : TPCOperationsComp;
FMaxOperationsPerBlock: Integer;
FMax0FeeOperationsPerBlock: Integer;
+ Procedure CheckMinerRecover(nbOperations: TPCOperationsComp);
Procedure DoProcessJSON(json : TPCJSONObject; ResponseMethod : String; Client : TJSONRPCTcpIpClient);
Procedure OnNodeNewBlock(Sender : TObject);
Procedure OnNodeOperationsChanged(Sender : TObject);
@@ -786,6 +790,11 @@ procedure TPoolMiningServer.FillMinerOperations;
if checkDuplicate then begin
if tree.IndexOfOperation(Op)>=0 then exit;
end;
+ if (Op is TOpRecoverFounds) then begin
+ if Not TAccountComp.EqualAccountKeys( TOpRecoverFounds(Op).Data.new_accountkey , FMinerAccountKey ) then begin
+ TLog.NewLog(lterror,ClassName,'Adding a OpRecoverFounds operation from another public key: '+Op.ToString);
+ end;
+ end;
tree.AddOperationToHashTree(Op);
End;
Var i,j : Integer;
@@ -801,6 +810,9 @@ procedure TPoolMiningServer.FillMinerOperations;
try
if (Not (TPCOperationsComp.EqualsOperationBlock(FMinerOperations.OperationBlock,LLockedMempool.OperationBlock))) then begin
FMinerOperations.Clear(true);
+ if LLockedMempool.SafeBoxTransaction.FreezedSafeBox.CurrentProtocol < CT_PROTOCOL_6 then begin
+ CheckMinerRecover(LLockedMempool);
+ end;
if LLockedMempool.Count>0 then begin
// First round: Select with fee > 0
i := 0;
@@ -942,6 +954,44 @@ function TPoolMiningServer.MinerSubmit(Client: TJSONRPCTcpIpClient; params: TPCJ
End;
end;
+// Looks for accounts to recover, adds up to 100 recoverFounds Operations to nbOperations
+procedure TPoolMiningServer.CheckMinerRecover(nbOperations: TPCOperationsComp);
+var
+ LAccOrd: TAccountsOrderedByUpdatedBlock;
+ LAccount: TAccount;
+ LRecoverAccounts: TList;
+ LIndexKey, LRecIndex, LRecoverAccountsCount: Integer;
+begin
+ LIndexKey := 0;
+ LRecoverAccountsCount := 0;
+ LRecoverAccounts := TList.Create(); // make a list of RecoverAccounts
+ nbOperations.Lock;
+ try
+ LAccOrd := nbOperations.bank.SafeBox.AccountsOrderedByUpdatedBlock; // Walk AccountsOrderedByUpdatedBlock, this keeps a list of the oldest accounts
+ if Assigned(LAccOrd) then begin
+ LAccount := CT_Account_NUL;
+ if LAccOrd.First(LIndexKey) then begin
+ LRecIndex := 0;
+ LRecoverAccountsCount := LAccOrd.Count;
+ while ((LRecIndex < LRecoverAccountsCount) and (LRecIndex < CT_MAX_0_fee_operations_per_block_by_miner)) do begin
+ LAccount := FNodeNotifyEvents.Node.GetMempoolAccount(LIndexKey);
+ if(TAccountComp.AccountCanRecover(LAccount, nbOperations.OperationBlock.block, nbOperations.bank.SafeBox.CurrentProtocol)) then begin // does the AccountCanRecover check, !locked, old enough, etc
+ LRecoverAccounts.Add(LAccount);
+ end else begin
+ Break; // we could not recover this account, then we can never recover move recent accounts
+ end;
+ if Not LAccOrd.Next(LIndexKey) then Break;
+ Inc(LRecIndex);
+ end;
+ nbOperations.AddMinerRecover(LRecoverAccounts,FMinerAccountKey);
+ end;
+ end;
+ finally
+ nbOperations.Unlock;
+ LRecoverAccounts.Free; // destroy the list, operations have been added
+ end;
+end;
+
procedure TPoolMiningServer.OnNewIncommingConnection(Sender: TObject; Client: TNetTcpIpClient);
var bClient : TJSONRPCTcpIpClient;
jsonobj : TPCJSONObject;
diff --git a/src/core/URPC.pas b/src/core/URPC.pas
index 6919d8401..f653cbe79 100644
--- a/src/core/URPC.pas
+++ b/src/core/URPC.pas
@@ -24,10 +24,12 @@ interface
{$I ./../config.inc}
+{$DEFINE RPC_PROTECT_MASSIVE_CALLS}
+
Uses UThread, ULog, UConst, UNode, UAccounts, UCrypto, UBlockChain,
UNetProtocol, UOpTransaction, UWallet, UTime, UPCEncryption, UTxMultiOperation,
UJSONFunctions, classes, blcksock, synsock,
- IniFiles, Variants, math, UBaseTypes,
+ IniFiles, Variants, math, UBaseTypes, UEPasa,
{$IFDEF Use_OpenSSL}
UOpenSSL,
{$ENDIF}
@@ -45,11 +47,15 @@ interface
CT_RPC_ErrNum_InvalidOperation = 1004;
CT_RPC_ErrNum_InvalidPubKey = 1005;
CT_RPC_ErrNum_InvalidAccountName = 1006;
+ CT_RPC_ErrNum_InvalidEPASA = 1007;
CT_RPC_ErrNum_NotFound = 1010;
CT_RPC_ErrNum_WalletPasswordProtected = 1015;
CT_RPC_ErrNum_InvalidData = 1016;
+ CT_RPC_ErrNum_AmbiguousPayload = 1017;
CT_RPC_ErrNum_InvalidSignature = 1020;
CT_RPC_ErrNum_NotAllowedCall = 1021;
+ CT_RPC_ErrNum_MaxCalls = 1022;
+
Type
@@ -60,18 +66,26 @@ interface
TPascalCoinJSONComp = Class
private
class function OperationsHashTreeToHexaString(Const OperationsHashTree : TOperationsHashTree) : String;
+ class function TryResolveOfflineEPASA(const AEPasa : TEPasa; out AResolvedAccount: Cardinal; out AErrorMessage: String): Boolean;
public
class procedure FillAccountObject(Const account : TAccount; jsonObj : TPCJSONObject);
class procedure FillBlockObject(nBlock : Cardinal; ANode : TNode; jsonObject: TPCJSONObject);
- class procedure FillOperationObject(Const OPR : TOperationResume; currentNodeBlocksCount : Cardinal; jsonObject : TPCJSONObject);
+ class procedure FillOperationObject(Const OPR : TOperationResume; currentNodeBlocksCount : Cardinal; const ANode : TNode; const AWalletKeys : TWalletKeys; const APasswords : TList; jsonObject : TPCJSONObject); overload;
class procedure FillOperationsHashTreeObject(Const OperationsHashTree : TOperationsHashTree; jsonObject : TPCJSONObject);
- class procedure FillMultiOperationObject(current_protocol : Word; Const multiOperation : TOpMultiOperation; jsonObject : TPCJSONObject);
+ class procedure FillMultiOperationObject(current_protocol : Word; Const multiOperation : TOpMultiOperation; const ANode : TNode; const AWalletKeys : TWalletKeys; const APasswords : TList; jsonObject : TPCJSONObject);
class procedure FillPublicKeyObject(const PubKey : TAccountKey; jsonObj : TPCJSONObject);
+ class function FillEPasaOrDecrypt(const AAccount : Int64; Const APayload : TOperationPayload; const ANode : TNode; const AWalletKeys : TWalletKeys; const APasswords : TList; jsonObject : TPCJSONObject) : Boolean;
class function ToPascalCoins(jsonCurr : Real) : Int64;
//
class Function HexaStringToOperationsHashTree(Const AHexaStringOperationsHashTree : String; ACurrentProtocol : Word; out AOperationsHashTree : TOperationsHashTree; var AErrors : String) : Boolean;
class Function CapturePubKey(const AInputParams : TPCJSONObject; const APrefix : String; var APubKey : TAccountKey; var AErrortxt : String) : Boolean;
- class function CheckAndGetEncodedRAWPayload(Const ARawPayload : TRawBytes; Const APayload_method, AEncodePwdForAES : String; const ASenderAccounKey, ATargetAccountKey : TAccountKey; out AOperationPayload : TOperationPayload; Var AErrorNum : Integer; Var AErrorDesc : String) : Boolean;
+ class function CheckAndGetEncodedRAWPayload(Const ARawPayload : TRawBytes; const APayloadType : TPayloadType; Const APayload_method, AEncodePwdForAES : String; const ASenderAccounKey, ATargetAccountKey : TAccountKey; out AOperationPayload : TOperationPayload; Var AErrorNum : Integer; Var AErrorDesc : String) : Boolean;
+ class Function CaptureNOperation(const AInputParams : TPCJSONObject; const AParamName : String; const ANode : TNode; out ALastNOp: Cardinal; var AErrorParam : String) : Boolean;
+ class Function CaptureAccountNumber(const AInputParams : TPCJSONObject; const AParamName : String; const ANode : TNode; out AResolvedAccount: Cardinal; var AErrorParam : String) : Boolean;
+ class Function CaptureMempoolAccount(const AInputParams : TPCJSONObject; const AParamName : String; const ANode : TNode; out AMempoolAccount: TAccount; var AErrorParam : String) : Boolean;
+ class Function CaptureEPASA(const AInputParams : TPCJSONObject; const AParamName : String; const ANode : TNode; out AEPasa: TEPasa; out AResolvedAccount: Cardinal; out AResolvedKey : TAccountKey; out ARequiresPurchase : Boolean; var AErrorParam : String) : Boolean; overload;
+ class Function CaptureEPASA(const AEPasaText : String; const ANode : TNode; out AEPasa: TEPasa; out AResolvedAccount: Cardinal; out AResolvedKey : TAccountKey; out ARequiresPurchase : Boolean; var AErrorParam : String) : Boolean; overload;
+ class Function OverridePayloadParams(const AInputParams : TPCJSONObject; const AEPASA : TEPasa) : Boolean;
end;
TRPCServerThread = Class;
@@ -89,13 +103,15 @@ interface
FValidIPs: String;
FAllowUsePrivateKeys: Boolean;
FNode : TNode;
+ FPayloadPasswords: TList;
+ FLiveConnectionsCount : Integer;
procedure SetActive(AValue: Boolean);
procedure SetIniFileName(const Value: String);
procedure SetLogFileName(const Value: String);
Function GetLogFileName : String;
procedure SetValidIPs(const Value: String); protected
Function IsValidClientIP(Const clientIp : String; clientPort : Word) : Boolean;
- Procedure AddRPCLog(Const Sender : String; Const Message : String);
+ Procedure AddRPCLog(Const Sender : String; ACallsCounter : Int64; Const Message : String);
Function GetNewCallCounter : Int64;
public
Constructor Create;
@@ -103,6 +119,7 @@ interface
Property Port : Word read FPort Write FPort;
Property Active : Boolean read FActive write SetActive;
Property WalletKeys : TWalletKeysExt read FWalletKeys write FWalletKeys;
+ Property PayloadPasswords: TList read FPayloadPasswords;
//
Property JSON20Strict : Boolean read FJSON20Strict write FJSON20Strict;
Property IniFileName : String read FIniFileName write SetIniFileName;
@@ -148,33 +165,46 @@ TRPCProcess = class(TPCThread)
class procedure RegisterProcessMethod(Const AMethodName : String; ARPCProcessMethod : TRPCProcessMethod);
class procedure UnregisterProcessMethod(Const AMethodName : String);
class function FindRegisteredProcessMethod(Const AMethodName : String) : TRPCProcessMethod;
+ class procedure ProcessMethodCalled(Const AMethodName : String; AStartTickCount : TTickCount);
end;
-
implementation
-Uses {$IFNDEF FPC}windows,{$ENDIF}
+Uses
+ {$IFNDEF FPC}windows,{$ENDIF}
SysUtils, Synautil,
- UPCRPCOpData, UPCRPCFindAccounts;
+ UEPasaDecoder,
+ UPCRPCSend,
+ UOrderedList,
+ UPCRPCOpData, UPCRPCFindAccounts, UPCRPCFindBlocks, UPCRPCFileUtils;
Type
TRegisteredRPCProcessMethod = Record
MethodName : String;
RPCProcessMethod : TRPCProcessMethod;
+ CallsCounter : Integer;
+ ElapsedMilis : Int64;
+ procedure Clear;
end;
+ PRegisteredRPCProcessMethod = ^TRegisteredRPCProcessMethod;
var _RPCServer : TRPCServer = Nil;
- _RPCProcessMethods : TList = Nil;
+ _RPCProcessMethods : TOrderedList = Nil;
+
+function TRegisteredRPCProcessMethod_Comparer(const ALeft,ARight : PRegisteredRPCProcessMethod) : Integer;
+begin
+ Result := AnsiCompareText(ALeft.MethodName , ARight.MethodName);
+end;
{ TPascalCoinJSONComp }
class procedure TPascalCoinJSONComp.FillBlockObject(nBlock : Cardinal; ANode : TNode; jsonObject: TPCJSONObject);
-var pcops : TPCOperationsComp;
- ob : TOperationBlock;
+var
+ ob, LOpBlock : TOperationBlock;
+ LAmount : Int64;
+ LOperationsCount : Integer;
begin
- pcops := TPCOperationsComp.Create(Nil);
- try
If ANode.Bank.BlocksCount<=nBlock then begin
Exit;
end;
@@ -197,20 +227,66 @@ class procedure TPascalCoinJSONComp.FillBlockObject(nBlock : Cardinal; ANode : T
jsonObject.GetAsVariant('pow').Value:=TCrypto.ToHexaString(ob.proof_of_work);
jsonObject.GetAsVariant('hashratekhs').Value := ANode.Bank.SafeBox.CalcBlockHashRateInKhs(ob.Block,50);
jsonObject.GetAsVariant('maturation').Value := ANode.Bank.BlocksCount - ob.block - 1;
- If ANode.Bank.LoadOperations(pcops,nBlock) then begin
- jsonObject.GetAsVariant('operations').Value:=pcops.Count;
+ if (ANode.Bank.Storage.GetBlockInformation(ob.block,LOpBlock,LOperationsCount,LAmount)) then begin
+ jsonObject.GetAsVariant('operations').Value:=LOperationsCount;
+ jsonObject.GetAsVariant('amount').Value:=LAmount;
+ end;
+end;
+
+class function TPascalCoinJSONComp.FillEPasaOrDecrypt(const AAccount: Int64;
+ const APayload: TOperationPayload; const ANode: TNode;
+ const AWalletKeys: TWalletKeys; const APasswords: TList;
+ jsonObject: TPCJSONObject) : Boolean;
+var LEPasa : TEPasa;
+ i : Integer;
+ pkey : TECPrivateKey;
+ decrypted_payload : TRawBytes;
+ LDecodeEPasaResult : TDecodeEPasaResult;
+begin
+ Result := False;
+ if AAccount>=0 then begin
+ if TEPasaDecoder.TryDecodeEPASA(AAccount,APayload,ANode,AWalletKeys,APasswords,LDecodeEPasaResult,LEPasa) then begin
+ jsonObject.GetAsVariant('account_epasa').Value := LEPasa.ToString;
+ jsonObject.GetAsVariant('unenc_payload').Value := LEPasa.Payload;
+ jsonObject.GetAsVariant('unenc_hexpayload').Value := LEPasa.GetRawPayloadBytes.ToHexaString;
+ Result := True;
+ end;
+ end;
+ if (Not Result) and (Assigned(AWalletKeys)) and (LDecodeEPasaResult<>der_PrivateKeyNotFound) then begin
+ for i := 0 to AWalletKeys.Count - 1 do begin
+ pkey := AWalletKeys.Key[i].PrivateKey;
+ if (assigned(pkey)) then begin
+ if TPCEncryption.DoPascalCoinECIESDecrypt(pkey.PrivateKey,APayload.payload_raw,decrypted_payload) then begin
+ jsonObject.GetAsVariant('unenc_payload').Value:= decrypted_payload.ToPrintable;
+ jsonObject.GetAsVariant('unenc_hexpayload').Value:= TCrypto.ToHexaString(decrypted_payload);
+ jsonObject.GetAsVariant('payload_method').Value:= 'key';
+ jsonObject.GetAsVariant('enc_pubkey').Value:= TCrypto.ToHexaString(TAccountComp.AccountKey2RawString(pkey.PublicKey));
+ Result := true;
+ end;
+ end;
+ end;
+ end;
+ if (Not Result) And Assigned(APasswords) and (LDecodeEPasaResult<>der_PasswordNotFound) then begin
+ for i := 0 to APasswords.Count - 1 do begin
+ if TPCEncryption.DoPascalCoinAESDecrypt(APayload.payload_raw,TEncoding.ANSI.GetBytes(APasswords[i]),decrypted_payload) then begin
+ jsonObject.GetAsVariant('unenc_payload').Value:= decrypted_payload.ToPrintable;
+ jsonObject.GetAsVariant('unenc_hexpayload').Value:= TCrypto.ToHexaString(decrypted_payload);
+ jsonObject.GetAsVariant('payload_method').Value:= 'pwd';
+ jsonObject.GetAsVariant('pwd').Value:=APasswords[i];
+ Result := true;
+ end;
end;
- finally
- pcops.Free;
end;
end;
-class procedure TPascalCoinJSONComp.FillOperationObject(const OPR: TOperationResume; currentNodeBlocksCount : Cardinal; jsonObject: TPCJSONObject);
+class procedure TPascalCoinJSONComp.FillOperationObject(const OPR: TOperationResume; currentNodeBlocksCount : Cardinal;
+ const ANode : TNode; const AWalletKeys : TWalletKeys; const APasswords : TList; jsonObject: TPCJSONObject);
Var i : Integer;
LOpChangeAccountInfoType : TOpChangeAccountInfoType;
LString : String;
jsonArr : TPCJSONArray;
auxObj : TPCJSONObject;
+ LEPasa : TEPasa;
procedure FillOpDataObject(AParentObj : TPCJSONObject; const AOpData : TMultiOpData);
var LDataObj : TPCJSONObject;
@@ -230,7 +306,7 @@ class procedure TPascalCoinJSONComp.FillOperationObject(const OPR: TOperationRes
end;
if OPR.valid then begin
jsonObject.GetAsVariant('block').Value:=OPR.Block;
- jsonObject.GetAsVariant('time').Value:=OPR.time;
+ if OPR.time>0 then jsonObject.GetAsVariant('time').Value:=OPR.time;
jsonObject.GetAsVariant('opblock').Value:=OPR.NOpInsideBlock;
if (OPR.Block>0) And (OPR.Block0) then jsonObject.GetAsVariant('n_operation').Value:=OPR.n_operation;
end;
- // New V3: Will include senders[], receivers[] and changers[]
+ // New V3: Will include senders[], receivers[] and changers[]
jsonArr := jsonObject.GetAsArray('senders');
for i:=Low(OPR.senders) to High(OPR.Senders) do begin
+ LString := TCrypto.ToHexaString(OPR.Senders[i].Payload.payload_raw);
auxObj := jsonArr.GetAsObject(jsonArr.Count);
auxObj.GetAsVariant('account').Value := OPR.Senders[i].Account;
+ FillEPasaOrDecrypt(OPR.Senders[i].Account,OPR.Senders[i].Payload,ANode,AWalletKeys,APasswords,auxObj);
if (OPR.Senders[i].N_Operation>0) then auxObj.GetAsVariant('n_operation').Value := OPR.Senders[i].N_Operation;
auxObj.GetAsVariant('amount').Value := TAccountComp.FormatMoneyDecimal(OPR.Senders[i].Amount * (-1));
auxObj.GetAsVariant('amount_s').Value := TAccountComp.FormatMoney (OPR.Senders[i].Amount * (-1));
- auxObj.GetAsVariant('payload').Value := TCrypto.ToHexaString(OPR.Senders[i].Payload.payload_raw);
+ auxObj.GetAsVariant('payload').Value := LString;
auxObj.GetAsVariant('payload_type').Value := OPR.Senders[i].Payload.payload_type;
if (OPR.OpType = CT_Op_Data) then begin
FillOpDataObject(auxObj, OPR.senders[i].OpData);
@@ -262,6 +340,7 @@ class procedure TPascalCoinJSONComp.FillOperationObject(const OPR: TOperationRes
for i:=Low(OPR.Receivers) to High(OPR.Receivers) do begin
auxObj := jsonArr.GetAsObject(jsonArr.Count);
auxObj.GetAsVariant('account').Value := OPR.Receivers[i].Account;
+ FillEPasaOrDecrypt(OPR.Receivers[i].Account,OPR.Receivers[i].Payload,ANode,AWalletKeys,APasswords,auxObj);
auxObj.GetAsVariant('amount').Value := TAccountComp.FormatMoneyDecimal(OPR.Receivers[i].Amount);
auxObj.GetAsVariant('amount_s').Value := TAccountComp.FormatMoney(OPR.Receivers[i].Amount);
auxObj.GetAsVariant('payload').Value := TCrypto.ToHexaString(OPR.Receivers[i].Payload.payload_raw);
@@ -332,6 +411,7 @@ class procedure TPascalCoinJSONComp.FillOperationObject(const OPR: TOperationRes
end;
If OPR.DestAccount>=0 then begin
jsonObject.GetAsVariant('dest_account').Value:=OPR.DestAccount;
+ FillEPasaOrDecrypt(OPR.DestAccount,OPR.OriginalPayload,ANode,AWalletKeys,APasswords,jsonObject);
end;
end;
If OPR.newKey.EC_OpenSSL_NID>0 then begin
@@ -345,6 +425,157 @@ class procedure TPascalCoinJSONComp.FillOperationObject(const OPR: TOperationRes
end;
end;
+class Function TPascalCoinJSONComp.CaptureNOperation(const AInputParams : TPCJSONObject; const AParamName : String; const ANode : TNode; out ALastNOp: Cardinal; var AErrorParam : String) : Boolean;
+var
+ LParamValue : String;
+begin
+ if NOT AInputParams.HasName(AParamName) then begin
+ AErrorParam := Format('Missing n-operation value for Param "%s"',[AParamName]);
+ Exit(False);
+ end;
+ // TODO: add type checking?
+ ALastNOp := AInputParams.AsCardinal(AParamName,0);
+end;
+
+class Function TPascalCoinJSONComp.CaptureAccountNumber(const AInputParams : TPCJSONObject; const AParamName : String; const ANode : TNode; out AResolvedAccount: Cardinal; var AErrorParam : String) : Boolean;
+var
+ LEPasa : TEPasa;
+ LKey : TAccountKey;
+ LPurchase : Boolean;
+ LParamValue : String;
+begin
+ LParamValue := AInputParams.AsString(AParamName,'');
+ Result := CaptureEPASA(AInputParams, AParamName, ANode, LEPasa, AResolvedAccount, LKey, LPurchase, AErrorParam);
+ if Result AND (NOT LEPasa.IsClassicPASA) then begin
+ AErrorParam := Format('"%s" is not valid Account Number for Param "%s"',[LParamValue,AParamName]);
+ Exit(False);
+ end;
+end;
+
+class function TPascalCoinJSONComp.CaptureEPASA(const AInputParams : TPCJSONObject; const AParamName : String; const ANode : TNode; out AEPasa: TEPasa; out AResolvedAccount: Cardinal; out AResolvedKey : TAccountKey; out ARequiresPurchase : Boolean; var AErrorParam : String): Boolean;
+var LParamValue : String;
+Begin
+ AEPasa.Clear;
+ AResolvedAccount := 0;
+ AResolvedKey.Clear;
+ ARequiresPurchase := False;
+ AErrorParam := '';
+ LParamValue := AInputParams.AsString(AParamName,'');
+ if Length(LParamValue)>0 then begin
+ if Not TEPasa.TryParse(LParamValue, AEPasa) then begin
+ AEPasa := TEPasa.Empty;
+ AResolvedAccount := CT_AccountNo_NUL;
+ AResolvedKey := CT_Account_NUL.accountInfo.accountKey;
+ AErrorParam := Format('"%s" is not valid Account EPASA for Param "%s"',[LParamValue,AParamName]);
+ Exit(False);
+ end;
+ if Assigned(ANode) then begin
+ Result := ANode.TryResolveEPASA(AEPasa, AResolvedAccount, AResolvedKey, ARequiresPurchase, AErrorParam);
+ end else begin
+ // Offline EPASA
+ Result := TryResolveOfflineEPASA(AEPasa, AResolvedAccount, AErrorParam);
+ AResolvedKey := CT_Account_NUL.accountInfo.accountKey;
+ ARequiresPurchase := False;
+ end;
+ end else begin
+ AEPasa := TEPasa.Empty;
+ AResolvedAccount := CT_AccountNo_NUL;
+ AResolvedKey := CT_Account_NUL.accountInfo.accountKey;
+ AErrorParam := Format('Param "%s" not provided or null',[AParamName]);
+ Exit(False);
+ end;
+end;
+
+class function TPascalCoinJSONComp.CaptureEPASA(const AEPasaText: String;
+ const ANode: TNode; out AEPasa: TEPasa; out AResolvedAccount: Cardinal;
+ out AResolvedKey: TAccountKey; out ARequiresPurchase: Boolean;
+ var AErrorParam: String): Boolean;
+Begin
+ AEPasa.Clear;
+ AResolvedAccount := 0;
+ AResolvedKey.Clear;
+ ARequiresPurchase := False;
+ AErrorParam := '';
+ if Length(AEPasaText)>0 then begin
+ if Not TEPasa.TryParse(AEPasaText, AEPasa) then begin
+ AEPasa := TEPasa.Empty;
+ AResolvedAccount := CT_AccountNo_NUL;
+ AResolvedKey := CT_Account_NUL.accountInfo.accountKey;
+ AErrorParam := Format('"%s" is not valid Account EPASA',[AEPasaText]);
+ Exit(False);
+ end;
+ if Assigned(ANode) then begin
+ Result := ANode.TryResolveEPASA(AEPasa, AResolvedAccount, AResolvedKey, ARequiresPurchase, AErrorParam);
+ end else begin
+ // Offline EPASA
+ Result := TryResolveOfflineEPASA(AEPasa, AResolvedAccount, AErrorParam);
+ AResolvedKey := CT_Account_NUL.accountInfo.accountKey;
+ ARequiresPurchase := False;
+ end;
+ end else begin
+ AEPasa := TEPasa.Empty;
+ AResolvedAccount := CT_AccountNo_NUL;
+ AResolvedKey := CT_Account_NUL.accountInfo.accountKey;
+ AErrorParam := Format('EPasa not provided or null',[]);
+ Exit(False);
+ end;
+end;
+
+class function TPascalCoinJSONComp.CaptureMempoolAccount(
+ const AInputParams: TPCJSONObject; const AParamName: String;
+ const ANode: TNode; out AMempoolAccount: TAccount;
+ var AErrorParam: String): Boolean;
+var LAccountNumber : Cardinal;
+begin
+ Result := CaptureAccountNumber(AInputParams,AParamName,ANode,LAccountNumber,AErrorParam);
+ if Result then begin
+ if (LAccountNumber>=0) And (LAccountNumber'') and (LPayloadmethod_old<>LPayloadmethod_new) then Exit(False);
+ AInputParams.GetAsVariant('payload_method').Value := LPayloadmethod_new;
+
+ if (LPayload_old<>'') and (LPayload_old<>LPayload_new) then Exit(False);
+ AInputParams.GetAsVariant('payload').Value := LPayload_new;
+
+ if (LPwd_old<>'') and (LPwd_old<>LPwd_new) then Exit(False);
+ if (LPwd_new<>'') then AInputParams.GetAsVariant('pwd').Value := LPwd_new;
+
+ Result := True;
+end;
+
class function TPascalCoinJSONComp.CapturePubKey(
const AInputParams: TPCJSONObject; const APrefix: String;
var APubKey: TAccountKey; var AErrortxt: String): Boolean;
@@ -381,27 +612,46 @@ class function TPascalCoinJSONComp.CapturePubKey(
end;
class function TPascalCoinJSONComp.CheckAndGetEncodedRAWPayload(
- const ARawPayload: TRawBytes; const APayload_method, AEncodePwdForAES: String;
+ const ARawPayload: TRawBytes;
+ const APayloadType : TPayloadType;
+ const APayload_method, AEncodePwdForAES: String;
const ASenderAccounKey, ATargetAccountKey: TAccountKey;
- out AOperationPayload : TOperationPayload; var AErrorNum: Integer;
+ out AOperationPayload : TOperationPayload;
+ var AErrorNum: Integer;
var AErrorDesc: String): Boolean;
+var LNewPayloadType : TPayloadType;
begin
AOperationPayload := CT_TOperationPayload_NUL;
- // XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
- // TODO:
- // Needs to assign AOperationPayload.payload_type based on PIP-0027
- // XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
+ AOperationPayload.payload_type := APayloadType.ToProtocolValue;
if (Length(ARawPayload)>0) then begin
+ if ARawPayload.ToPrintable.CompareTo(ARawPayload.ToString)=0 then LNewPayloadType := [ptAsciiFormatted]
+ else LNewPayloadType := [];
if (APayload_method='none') then begin
AOperationPayload.payload_raw:=ARawPayload;
+ if (AOperationPayload.payload_type=0) then begin
+ LNewPayloadType := LNewPayloadType + [ptPublic];
+ AOperationPayload.payload_type := LNewPayloadType.ToProtocolValue;
+ end;
Result := True;
end else if (APayload_method='dest') then begin
Result := TPCEncryption.DoPascalCoinECIESEncrypt(ATargetAccountKey,ARawPayload,AOperationPayload.payload_raw);
+ if (AOperationPayload.payload_type=0) then begin
+ LNewPayloadType := LNewPayloadType + [ptRecipientKeyEncrypted];
+ AOperationPayload.payload_type := LNewPayloadType.ToProtocolValue;
+ end;
end else if (APayload_method='sender') then begin
Result := TPCEncryption.DoPascalCoinECIESEncrypt(ASenderAccounKey,ARawPayload,AOperationPayload.payload_raw);
+ if (AOperationPayload.payload_type=0) then begin
+ LNewPayloadType := LNewPayloadType + [ptSenderKeyEncrypted];
+ AOperationPayload.payload_type := LNewPayloadType.ToProtocolValue;
+ end;
end else if (APayload_method='aes') then begin
AOperationPayload.payload_raw := TPCEncryption.DoPascalCoinAESEncrypt(ARawPayload,TEncoding.ANSI.GetBytes(AEncodePwdForAES));
Result := True;
+ if (AOperationPayload.payload_type=0) then begin
+ LNewPayloadType := LNewPayloadType + [ptPasswordEncrypted];
+ AOperationPayload.payload_type := LNewPayloadType.ToProtocolValue;
+ end;
end else begin
Result := False;
AErrorNum:=CT_RPC_ErrNum_InvalidOperation;
@@ -468,11 +718,13 @@ class procedure TPascalCoinJSONComp.FillOperationsHashTreeObject(const Operation
jsonObject.GetAsVariant('rawoperations').Value:=OperationsHashTreeToHexaString(OperationsHashTree);
end;
-class procedure TPascalCoinJSONComp.FillMultiOperationObject(current_protocol : Word; const multiOperation: TOpMultiOperation; jsonObject: TPCJSONObject);
+class procedure TPascalCoinJSONComp.FillMultiOperationObject(current_protocol : Word; const multiOperation: TOpMultiOperation;
+ const ANode : TNode; const AWalletKeys : TWalletKeys; const APasswords : TList; jsonObject: TPCJSONObject);
Var i, nSigned, nNotSigned : Integer;
opht : TOperationsHashTree;
jsonArr : TPCJSONArray;
auxObj : TPCJSONObject;
+ LStr : String;
begin
opht := TOperationsHashTree.Create;
Try
@@ -493,18 +745,22 @@ class procedure TPascalCoinJSONComp.FillMultiOperationObject(current_protocol :
//
jsonArr := jsonObject.GetAsArray('senders');
for i:=Low(multiOperation.Data.txSenders) to High(multiOperation.Data.txSenders) do begin
+ LStr := TCrypto.ToHexaString(multiOperation.Data.txSenders[i].Payload.payload_raw);
auxObj := jsonArr.GetAsObject(jsonArr.Count);
auxObj.GetAsVariant('account').Value := multiOperation.Data.txSenders[i].Account;
+ FillEPasaOrDecrypt(multiOperation.Data.txSenders[i].Account,multiOperation.Data.txSenders[i].Payload,ANode,AWalletKeys,APasswords,auxObj);
auxObj.GetAsVariant('n_operation').Value := multiOperation.Data.txSenders[i].N_Operation;
auxObj.GetAsVariant('amount').Value := TAccountComp.FormatMoneyDecimal(multiOperation.Data.txSenders[i].Amount * (-1));
- auxObj.GetAsVariant('payload').Value := TCrypto.ToHexaString(multiOperation.Data.txSenders[i].Payload.payload_raw);
+ auxObj.GetAsVariant('payload').Value := LStr;
auxObj.GetAsVariant('payload_type').Value := multiOperation.Data.txSenders[i].Payload.payload_type;
end;
//
jsonArr := jsonObject.GetAsArray('receivers');
for i:=Low(multiOperation.Data.txReceivers) to High(multiOperation.Data.txReceivers) do begin
+ LStr := TCrypto.ToHexaString(multiOperation.Data.txSenders[i].Payload.payload_raw);
auxObj := jsonArr.GetAsObject(jsonArr.Count);
auxObj.GetAsVariant('account').Value := multiOperation.Data.txReceivers[i].Account;
+ FillEPasaOrDecrypt(multiOperation.Data.txReceivers[i].Account,multiOperation.Data.txReceivers[i].Payload,ANode,AWalletKeys,APasswords,auxObj);
auxObj.GetAsVariant('amount').Value := TAccountComp.FormatMoneyDecimal(multiOperation.Data.txReceivers[i].Amount);
auxObj.GetAsVariant('payload').Value := TCrypto.ToHexaString(multiOperation.Data.txReceivers[i].Payload.payload_raw);
auxObj.GetAsVariant('payload_type').Value := multiOperation.Data.txReceivers[i].Payload.payload_type;
@@ -597,6 +853,27 @@ class function TPascalCoinJSONComp.OperationsHashTreeToHexaString(const Operatio
End;
end;
+
+class function TPascalCoinJSONComp.TryResolveOfflineEPASA(const AEPasa : TEPasa; out AResolvedAccount: Cardinal; out AErrorMessage: String): Boolean;
+begin
+ if (AEPasa.IsPayToKey) then begin
+ // PayToKey not supported in offline signing
+ AResolvedAccount := CT_AccountNo_NUL;
+ AErrorMessage := 'PayToKey not supported in offline signing';
+ Exit(False);
+ end else if (AEPasa.IsAddressedByName) then begin
+ // PayToKey not supported in offline signing
+ AResolvedAccount := CT_AccountNo_NUL;
+ AErrorMessage := 'Addressed-by-name EPASA not supported in offline signing';
+ Exit(False);
+ end;
+ // addressed by number
+ if NOT AEPasa.IsAddressedByNumber then raise Exception.Create('Internal Error 0293f104-fce6-46a5-853f-e91fb501b452');
+ if NOT AEPasa.Account.HasValue then raise Exception.Create('Internal Error b569cd90-8dd7-4fac-95c4-6508179dac03');
+ AResolvedAccount := AEPasa.Account.Value;
+ Result := true;
+end;
+
class function TPascalCoinJSONComp.ToPascalCoins(jsonCurr: Real): Int64;
begin
Result := Round(jsonCurr * 10000);
@@ -604,10 +881,10 @@ class function TPascalCoinJSONComp.ToPascalCoins(jsonCurr: Real): Int64;
{ TRPCServer }
-Procedure TRPCServer.AddRPCLog(Const Sender : String; Const Message : String);
+Procedure TRPCServer.AddRPCLog(Const Sender : String; ACallsCounter : Int64; Const Message : String);
Begin
If Not Assigned(FRPCLog) then exit;
- FRPCLog.NotifyNewLog(ltinfo,Sender+' '+Inttostr(FCallsCounter),Message);
+ FRPCLog.NotifyNewLog(ltinfo,Sender+' '+Inttostr(ACallsCounter),Message);
end;
Function TRPCServer.GetLogFileName : String;
@@ -718,6 +995,7 @@ function TRPCServer.CheckAndGetPrivateKeyInWallet(const APublicKey : TAccountKey
constructor TRPCServer.Create;
begin
+ FPayloadPasswords := TList.Create;
FActive := false;
FRPCLog := Nil;
FIniFile := Nil;
@@ -730,12 +1008,14 @@ constructor TRPCServer.Create;
FValidIPs := '127.0.0.1;localhost'; // New Build 1.5 - By default, only localhost can access to RPC
FAllowUsePrivateKeys := True; // New Build 3.0.2 - By default RPC allows to use private keys functions
FNode := TNode.Node;
+ FLiveConnectionsCount := 0;
If Not assigned(_RPCServer) then _RPCServer := Self;
end;
destructor TRPCServer.Destroy;
begin
FreeAndNil(FRPCLog);
+ FreeAndNil(FPayloadPasswords);
active := false;
if _RPCServer=Self then _RPCServer:=Nil;
inherited Destroy;
@@ -746,6 +1026,7 @@ destructor TRPCServer.Destroy;
constructor TRPCProcess.Create(ARPCServer : TRPCServer; AHSock:tSocket);
begin
FRPCServer := ARPCServer;
+ Inc(FRPCServer.FLiveConnectionsCount);
FSock:=TTCPBlockSocket.create;
FSock.socket:=AHSock;
FreeOnTerminate:=true;
@@ -758,25 +1039,47 @@ constructor TRPCProcess.Create(ARPCServer : TRPCServer; AHSock:tSocket);
destructor TRPCProcess.Destroy;
begin
+ Dec(FRPCServer.FLiveConnectionsCount);
FSock.free;
inherited Destroy;
end;
class function TRPCProcess.FindRegisteredProcessMethod(const AMethodName: String): TRPCProcessMethod;
var i : Integer;
+ P : PRegisteredRPCProcessMethod;
begin
Result := Nil;
if Not Assigned(_RPCProcessMethods) then Exit;
- i := 0;
- while (i<_RPCProcessMethods.Count) and (Not Assigned(Result)) do begin
- if AnsiSameStr( _RPCProcessMethods.Items[i].MethodName , AMethodName) then begin
- Result := _RPCProcessMethods.Items[i].RPCProcessMethod;
+ New(P);
+ Try
+ P.Clear;
+ P.MethodName := AMethodName;
+ if _RPCProcessMethods.Find(P,i) then begin
+ Result := _RPCProcessMethods.Get(i).RPCProcessMethod;
end;
- inc(i);
- end;
+ Finally
+ Dispose(P);
+ End;
end;
procedure TRPCProcess.BCExecute;
+ function ValidMethodName(const AMethod : String) : Boolean;
+ var i : Integer;
+ begin
+ Result := False;
+ for i:=0 to AMethod.Length-1 do begin
+ case AMethod.Chars[i] of
+ 'a'..'z',
+ 'A'..'Z',
+ '0'..'9',
+ '_','.' : ; // Nothing to do
+ '-' : if i=0 then Exit; // Cannot start with "-"
+ else Exit; // Not a valid char
+ end;
+ end;
+ Result := True;
+ end;
+
var
timeout: integer;
s: string;
@@ -786,16 +1089,19 @@ procedure TRPCProcess.BCExecute;
resultcode: integer;
inputdata : TRawBytes;
js,jsresult : TPCJSONData;
- jsonobj,jsonresponse : TPCJSONObject;
+ jsonobj,jsonresponse, paramsJSON : TPCJSONObject;
errNum : Integer; errDesc : String;
jsonrequesttxt,
- jsonresponsetxt, methodName, paramsTxt : String;
+ jsonresponsetxt, methodName, paramsTxt, senderIP : String;
valid : Boolean;
i : Integer;
Headers : TStringList;
tc : TTickCount;
callcounter : Int64;
+ LOnStartLiveConnectionCount : Integer;
begin
+ LOnStartLiveConnectionCount := FRPCServer.FLiveConnectionsCount;
+ senderIP := '';
callcounter := _RPCServer.GetNewCallCounter;
tc := TPlatform.GetTickCount;
methodName := '';
@@ -803,7 +1109,7 @@ procedure TRPCProcess.BCExecute;
// IP Protection
If (Not _RPCServer.IsValidClientIP(FSock.GetRemoteSinIP,FSock.GetRemoteSinPort)) then begin
TLog.NewLog(lterror,Classname,FSock.GetRemoteSinIP+':'+inttostr(FSock.GetRemoteSinPort)+' INVALID IP');
- _RPCServer.AddRPCLog(FSock.GetRemoteSinIP+':'+InttoStr(FSock.GetRemoteSinPort),' INVALID IP');
+ _RPCServer.AddRPCLog(FSock.GetRemoteSinIP+':'+InttoStr(FSock.GetRemoteSinPort),callcounter,' INVALID IP');
exit;
end;
errNum := CT_RPC_ErrNum_InternalError;
@@ -869,9 +1175,27 @@ procedure TRPCProcess.BCExecute;
errDesc := '';
try
methodName := jsonobj.AsString('method','');
- paramsTxt := jsonobj.GetAsObject('params').ToJSON(false);
+ paramsJSON := jsonobj.GetAsObject('params');
+ senderIP := Trim(jsonObj.AsString('remoteaddr','')); //
+ paramsTxt := paramsJSON.ToJSON(false);
{$IFDEF HIGHLOG}TLog.NewLog(ltinfo,Classname,FSock.GetRemoteSinIP+':'+inttostr(FSock.GetRemoteSinPort)+' Processing method '+methodName+' params '+paramsTxt);{$ENDIF}
- Valid := ProcessMethod(methodName,jsonobj.GetAsObject('params'),jsonresponse,errNum,errDesc);
+ valid := True;
+ {$IFDEF RPC_PROTECT_MASSIVE_CALLS}
+ if (senderIP<>'') and (ValidMethodName(methodName)) then begin
+ if TNetData.NetData.IpInfos.Update_And_ReachesLimits(senderIP,'rpcmethod',methodName,0,True,
+ TArray.Create(TLimitLifetime.Create(60,50,0),TLimitLifetime.Create(3600,500,0))) then begin
+ valid := false;
+ errNum := CT_RPC_ErrNum_MaxCalls;
+ errDesc := Format('IP:%s Reached limit %s',[senderIP,methodName]);
+ jsonresponse.GetAsObject('error').GetAsVariant('code').Value:=errNum;
+ jsonresponse.GetAsObject('error').GetAsVariant('message').Value:=errDesc;
+ end;
+ end;
+ {$ENDIF}
+ if valid then begin
+
+ TRPCProcess.ProcessMethodCalled(methodName,tc);
+ Valid := ProcessMethod(methodName,paramsJSON,jsonresponse,errNum,errDesc);
if not Valid then begin
if (errNum<>0) or (errDesc<>'') then begin
jsonresponse.GetAsObject('error').GetAsVariant('code').Value:=errNum;
@@ -881,6 +1205,8 @@ procedure TRPCProcess.BCExecute;
jsonresponse.GetAsObject('error').GetAsVariant('message').Value:='Unknown error processing method';
end;
end;
+
+ end;
Except
on E:Exception do begin
TLog.NewLog(lterror,Classname,'Exception processing method'+methodName+' ('+E.ClassName+'): '+E.Message);
@@ -927,7 +1253,14 @@ procedure TRPCProcess.BCExecute;
FSock.SendString(jsonresponsetxt);
end;
end;
- _RPCServer.AddRPCLog(FSock.GetRemoteSinIP+':'+InttoStr(FSock.GetRemoteSinPort),'Method:'+methodName+' Params:'+paramsTxt+' '+Inttostr(errNum)+':'+errDesc+' Time:'+FormatFloat('0.000',(TPlatform.GetElapsedMilliseconds(tc)/1000)));
+ if senderIP<>'' then begin
+ senderIP := FSock.GetRemoteSinIP+':'+InttoStr(FSock.GetRemoteSinPort) + ' @'+senderIP;
+ end else begin
+ senderIP := FSock.GetRemoteSinIP+':'+InttoStr(FSock.GetRemoteSinPort);
+ end;
+ _RPCServer.AddRPCLog(senderIP,callcounter,'Method:'+methodName+' Params:'+paramsTxt+' '+Inttostr(errNum)+':'+errDesc+' Time:'+FormatFloat('0.000',(TPlatform.GetElapsedMilliseconds(tc)/1000))
+ +' '+LOnStartLiveConnectionCount.ToString+'->'+FRPCServer.FLiveConnectionsCount.ToString);
+ TRPCProcess.ProcessMethodCalled(methodName,tc);
finally
jsonresponse.free;
Headers.Free;
@@ -998,6 +1331,8 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
Function GetBlock(nBlock : Cardinal; jsonObject : TPCJSONObject) : Boolean;
begin
+ FNode.OperationSequenceLock.Acquire; // Added to prevent high concurrent API calls
+ try
If FNode.Bank.BlocksCount<=nBlock then begin
ErrorNum := CT_RPC_ErrNum_InvalidBlock;
ErrorDesc := 'Cannot load Block: '+IntToStr(nBlock);
@@ -1006,11 +1341,78 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
end;
TPascalCoinJSONComp.FillBlockObject(nBlock,FNode,jsonObject);
Result := True;
+ finally
+ FNode.OperationSequenceLock.Release;
+ end;
+ end;
+
+ Function GetBlockOperation(ABlock, AOpBlock : Integer; jsonObject : TPCJSONObject) : Boolean;
+ var LOpResumeList : TOperationsResumeList;
+ LOperationBlock : TOperationBlock;
+ LOperationsCount : Integer;
+ LOperationsAmount : Int64;
+ begin
+ FNode.OperationSequenceLock.Acquire; // Added to prevent high concurrent API calls
+ try
+ LOpResumeList := TOperationsResumeList.Create;
+ Try
+ if not FNode.Bank.Storage.GetBlockOperations(ABlock,AOpBlock,1,LOperationBlock,LOperationsCount,LOperationsAmount,LOpResumeList) then begin
+ ErrorNum := CT_RPC_ErrNum_InvalidOperation;
+ ErrorDesc := 'Cannot load Block: '+ABlock.ToString+' OpBlock: '+AOpBlock.ToString;
+ Result := False;
+ Exit;
+ end;
+ if LOpResumeList.Count<>1 then Exit(False);
+ TPascalCoinJSONComp.FillOperationObject(LOpResumeList.Items[0],
+ FNode.Bank.BlocksCount,
+ Node,RPCServer.WalletKeys,RPCServer.PayloadPasswords,
+ jsonObject);
+ Result := True;
+ Finally
+ LOpResumeList.Free;
+ End;
+ finally
+ FNode.OperationSequenceLock.Release;
+ end;
+ end;
+
+
+ Function GetBlockOperations(ABlock, AOpBlockStartIndex, AMaxOperations : Integer; jsonArray : TPCJSONArray) : Boolean;
+ var LOpResumeList : TOperationsResumeList;
+ LOperationBlock : TOperationBlock;
+ LOperationsCount : Integer;
+ LOperationsAmount : Int64;
+ i : Integer;
+ begin
+ FNode.OperationSequenceLock.Acquire; // Added to prevent high concurrent API calls
+ try
+ LOpResumeList := TOperationsResumeList.Create;
+ Try
+ if not FNode.Bank.Storage.GetBlockOperations(ABlock,AOpBlockStartIndex,AMaxOperations,LOperationBlock,LOperationsCount,LOperationsAmount,LOpResumeList) then begin
+ ErrorNum := CT_RPC_ErrNum_InvalidOperation;
+ ErrorDesc := 'Cannot load Block: '+ABlock.ToString+' OpBlock: '+AOpBlockStartIndex.ToString+' Max: '+AMaxOperations.ToString;
+ Result := False;
+ Exit;
+ end;
+ for i := 0 to LOpResumeList.Count-1 do begin
+ TPascalCoinJSONComp.FillOperationObject(LOpResumeList.Items[i],FNode.Bank.BlocksCount,
+ Node,RPCServer.WalletKeys,RPCServer.PayloadPasswords,
+ jsonArray.GetAsObject(jsonArray.Count));
+ end;
+ Result := True;
+ Finally
+ LOpResumeList.Free;
+ End;
+ finally
+ FNode.OperationSequenceLock.Release;
+ end;
end;
Procedure FillOperationResumeToJSONObject(Const OPR : TOperationResume; jsonObject : TPCJSONObject);
Begin
- TPascalCoinJSONComp.FillOperationObject(OPR,FNode.Bank.BlocksCount,jsonObject);
+ TPascalCoinJSONComp.FillOperationObject(OPR,FNode.Bank.BlocksCount,
+ Node,RPCServer.WalletKeys,RPCServer.PayloadPasswords,
+ jsonObject);
end;
Function GetAccountOperations(accountNumber : Cardinal; jsonArray : TPCJSONArray; maxBlocksDepth, startReg, maxReg: Integer; forceStartBlock : Cardinal) : Boolean;
@@ -1023,6 +1425,8 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
LLockedMempool : TPCOperationsComp;
Begin
Result := false;
+ FNode.OperationSequenceLock.Acquire; // Added to prevent high concurrent API calls
+ try
if (startReg<-1) or (maxReg<=0) then begin
ErrorNum := CT_RPC_ErrNum_InvalidData;
ErrorDesc := 'Invalid start or max value';
@@ -1060,7 +1464,7 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
end;
if (nCounter0 then begin
+ obj.GetAsVariant('secs_average').Value := FormatFloat('0.000',(P.ElapsedMilis/1000)/P.CallsCounter);
+ end;
+ inc(LCalls,P.CallsCounter);
+ inc(LMilis,P.ElapsedMilis);
+ inc(i);
+ end;
+ obj := GetResultArray.GetAsObject(GetResultArray.Count);
+ obj.GetAsVariant('method').Value := 'TOTAL';
+ obj.GetAsVariant('calls').Value := LCalls;
+ obj.GetAsVariant('seconds').Value := FormatFloat('0.000',LMilis/1000);
+ if LCalls>0 then begin
+ obj.GetAsVariant('secs_average').Value := FormatFloat('0.000',(LMilis/1000)/LCalls);
+ end;
+ end;
+
// This function creates a TOpTransaction without looking for balance/private key of sender account
// It assumes that sender,target,sender_last_n_operation,senderAccountKey and targetAccountKey are correct
Function CreateOperationTransaction(current_protocol : Word; sender, target, sender_last_n_operation : Cardinal; amount, fee : UInt64;
@@ -1162,7 +1601,7 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
Begin
Result := Nil;
if Not RPCServer.CheckAndGetPrivateKeyInWallet(senderAccounKey,privateKey,ErrorNum,ErrorDesc) then Exit(Nil);
- if Not TPascalCoinJSONComp.CheckAndGetEncodedRAWPayload(RawPayload,Payload_method,EncodePwd,senderAccounKey,targetAccountKey,LOpPayload,ErrorNum,ErrorDesc) then Exit(Nil);
+ if Not TPascalCoinJSONComp.CheckAndGetEncodedRAWPayload(RawPayload,[ptNonDeterministic],Payload_method,EncodePwd,senderAccounKey,targetAccountKey,LOpPayload,ErrorNum,ErrorDesc) then Exit(Nil);
Result := TOpTransaction.CreateTransaction(current_protocol, sender,sender_last_n_operation+1,target,privateKey,amount,fee,LOpPayload);
if Not Result.HasValidSignature then begin
FreeAndNil(Result);
@@ -1175,98 +1614,9 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
Function CaptureAccountNumber(const AParamName : String; const ACheckAccountNumberExistsInSafebox : Boolean; var AAccountNumber : Cardinal; var AErrorParam : String) : Boolean;
var LParamValue : String;
Begin
- LParamValue := params.AsString(AParamName,'');
- if Length(LParamValue)>0 then begin
- Result := TAccountComp.AccountTxtNumberToAccountNumber(LParamValue,AAccountNumber);
- if Not Result then begin
- AErrorParam := Format('"%s" is no valid Account number for Param "%s"',[LParamValue,AParamName]);
- end else if (ACheckAccountNumberExistsInSafebox) then begin
- if (AAccountNumber<0) or (AAccountNumber>=FNode.Bank.AccountsCount) then begin
- Result := False;
- AErrorParam := Format('Account %d does not exist in safebox (param "%s")',[AAccountNumber,AParamName]);
- end;
- end;
- end else begin
- Result := False;
- AErrorParam := Format('Param "%s" not provided or null',[AParamName]);
- end;
+ Result := TPascalCoinJSONComp.CaptureAccountNumber(params,AParamName,FNode,AAccountNumber,AErrorParam);
End;
- Function OpSendTo(sender, target : Cardinal; amount, fee : UInt64; Const RawPayload : TRawBytes; Const Payload_method, EncodePwd : String) : Boolean;
- // "payload_method" types: "none","dest"(default),"sender","aes"(must provide "pwd" param)
- Var opt : TOpTransaction;
- sacc,tacc : TAccount;
- errors : String;
- opr : TOperationResume;
- begin
- FNode.OperationSequenceLock.Acquire; // Use lock to prevent N_Operation race-condition on concurrent sends
- try
- Result := false;
- if (sender<0) or (sender>=FNode.Bank.AccountsCount) then begin
- If (sender=CT_MaxAccount) then ErrorDesc := 'Need sender'
- else ErrorDesc:='Invalid sender account '+Inttostr(sender);
- ErrorNum:=CT_RPC_ErrNum_InvalidAccount;
- Exit;
- end;
- if (target<0) or (target>=FNode.Bank.AccountsCount) then begin
- If (target=CT_MaxAccount) then ErrorDesc := 'Need target'
- else ErrorDesc:='Invalid target account '+Inttostr(target);
- ErrorNum:=CT_RPC_ErrNum_InvalidAccount;
- Exit;
- end;
- sacc := FNode.GetMempoolAccount(sender);
- tacc := FNode.GetMempoolAccount(target);
-
- opt := CreateOperationTransaction(FNode.Bank.SafeBox.CurrentProtocol,sender,target,sacc.n_operation,amount,fee,sacc.accountInfo.accountKey,tacc.accountInfo.accountKey,RawPayload,Payload_method,EncodePwd);
- if opt=nil then exit;
- try
- If not FNode.AddOperation(Nil,opt,errors) then begin
- ErrorDesc := 'Error adding operation: '+errors;
- ErrorNum := CT_RPC_ErrNum_InvalidOperation;
- Exit;
- end;
- TPCOperation.OperationToOperationResume(0,opt,False,sender,opr);
- FillOperationResumeToJSONObject(opr,GetResultObject);
- Result := true;
- finally
- opt.free;
- end;
- finally
- FNode.OperationSequenceLock.Release;
- end;
- end;
-
- Function SignOpSendTo(Const HexaStringOperationsHashTree : String; current_protocol : Word;
- sender, target : Cardinal;
- Const senderAccounKey, targetAccountKey : TAccountKey;
- last_sender_n_operation : Cardinal;
- amount, fee : UInt64; Const RawPayload : TRawBytes; Const Payload_method, EncodePwd : String) : Boolean;
- // "payload_method" types: "none","dest"(default),"sender","aes"(must provide "pwd" param)
- var OperationsHashTree : TOperationsHashTree;
- errors : String;
- opt : TOpTransaction;
- begin
- Result := false;
- if Not TPascalCoinJSONComp.HexaStringToOperationsHashTree(HexaStringOperationsHashTree,current_protocol,OperationsHashTree,errors) then begin
- ErrorNum:=CT_RPC_ErrNum_InvalidData;
- ErrorDesc:= 'Error decoding param "rawoperations": '+errors;
- Exit;
- end;
- Try
- opt := CreateOperationTransaction(current_protocol, sender,target,last_sender_n_operation,amount,fee,senderAccounKey,targetAccountKey,RawPayload,Payload_method,EncodePwd);
- if opt=nil then exit;
- try
- OperationsHashTree.AddOperationToHashTree(opt);
- TPascalCoinJSONComp.FillOperationsHashTreeObject(OperationsHashTree,GetResultObject);
- Result := true;
- finally
- opt.Free;
- end;
- Finally
- OperationsHashTree.Free;
- End;
- end;
-
// This function creates a TOpChangeKey without looking for private key of account
// It assumes that account_signer,account_last_n_operation, account_target and account_pubkey are correct
Function CreateOperationChangeKey(current_protocol : Word; account_signer, account_last_n_operation, account_target : Cardinal; const account_pubkey, new_pubkey : TAccountKey; fee : UInt64; RawPayload : TRawBytes; Const Payload_method, EncodePwd : String) : TOpChangeKey;
@@ -1279,7 +1629,7 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
Result := Nil;
LOpPayload := CT_TOperationPayload_NUL;
if Not RPCServer.CheckAndGetPrivateKeyInWallet(account_pubkey,privateKey,ErrorNum,ErrorDesc) then Exit(Nil);
- if Not TPascalCoinJSONComp.CheckAndGetEncodedRAWPayload(RawPayload,Payload_method,EncodePwd,account_pubkey,new_pubkey,LOpPayload,ErrorNum,ErrorDesc) then Exit(Nil);
+ if Not TPascalCoinJSONComp.CheckAndGetEncodedRAWPayload(RawPayload,[ptNonDeterministic],Payload_method,EncodePwd,account_pubkey,new_pubkey,LOpPayload,ErrorNum,ErrorDesc) then Exit(Nil);
If account_signer=account_target then begin
Result := TOpChangeKey.Create(current_protocol,account_signer,account_last_n_operation+1,account_target,privateKey,new_pubkey,fee,LOpPayload);
end else begin
@@ -1346,7 +1696,7 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
// If using 'dest', only will apply if there is a fixed new public key, otherwise will use current public key of account
aux_target_pubkey := new_account_pubkey;
end else aux_target_pubkey := account_signer_pubkey;
- if Not TPascalCoinJSONComp.CheckAndGetEncodedRAWPayload(RawPayload,Payload_method,EncodePwd,account_signer_pubkey,aux_target_pubkey,LOpPayload,ErrorNum,ErrorDesc) then Exit(Nil);
+ if Not TPascalCoinJSONComp.CheckAndGetEncodedRAWPayload(RawPayload,[ptNonDeterministic],Payload_method,EncodePwd,account_signer_pubkey,aux_target_pubkey,LOpPayload,ErrorNum,ErrorDesc) then Exit(Nil);
Result := TOpListAccountForSaleOrSwap.CreateListAccountForSaleOrSwap(
current_protocol,
ANewAccountState,
@@ -1381,7 +1731,7 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
Result := Nil;
LOpPayload := CT_TOperationPayload_NUL;
if Not RPCServer.CheckAndGetPrivateKeyInWallet(account_signer_pubkey,privateKey,ErrorNum,ErrorDesc) then Exit(Nil);
- if Not TPascalCoinJSONComp.CheckAndGetEncodedRAWPayload(RawPayload,Payload_method,EncodePwd,account_signer_pubkey,account_signer_pubkey,LOpPayload,ErrorNum,ErrorDesc) then Exit(Nil);
+ if Not TPascalCoinJSONComp.CheckAndGetEncodedRAWPayload(RawPayload, [ptNonDeterministic],Payload_method,EncodePwd,account_signer_pubkey,account_signer_pubkey,LOpPayload,ErrorNum,ErrorDesc) then Exit(Nil);
Result := TOpDelistAccountForSale.CreateDelistAccountForSale(current_protocol,account_signer,account_last_n_operation+1,account_delisted,fee,privateKey,LOpPayload);
if Not Result.HasValidSignature then begin
FreeAndNil(Result);
@@ -1404,7 +1754,7 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
Begin
Result := Nil;
if Not RPCServer.CheckAndGetPrivateKeyInWallet(account_pubkey,privateKey,ErrorNum,ErrorDesc) then Exit(Nil);
- if Not TPascalCoinJSONComp.CheckAndGetEncodedRAWPayload(RawPayload,Payload_method,EncodePwd,account_pubkey,new_account_pubkey,LOpPayload,ErrorNum,ErrorDesc) then Exit(Nil);
+ if Not TPascalCoinJSONComp.CheckAndGetEncodedRAWPayload(RawPayload,[ptNonDeterministic],Payload_method,EncodePwd,account_pubkey,new_account_pubkey,LOpPayload,ErrorNum,ErrorDesc) then Exit(Nil);
Result := TOpBuyAccount.CreateBuy(current_protocol,account_number,account_last_n_operation+1,account_to_buy,account_to_pay,account_price,amount,fee,new_account_pubkey,privateKey,LOpPayload);
if Not Result.HasValidSignature then begin
FreeAndNil(Result);
@@ -1578,7 +1928,9 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
If TPCOperation.OperationToOperationResume(0,Op,True,Op.SignerAccount,OPR) then begin
OPR.NOpInsideBlock := i;
OPR.Balance := -1;
- end else OPR := CT_TOperationResume_NUL;
+ end else begin
+ OPR := CT_TOperationResume_NUL;
+ end;
FillOperationResumeToJSONObject(OPR,Obj);
end;
Result := true;
@@ -1642,48 +1994,44 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
Result := true;
end;
- Function DoDecrypt(RawEncryptedPayload : TRawBytes; jsonArrayPwds : TPCJSONArray) : Boolean;
+ Function DoDecrypt(jsonArrayPwds : TPCJSONArray) : Boolean;
var i : Integer;
pkey : TECPrivateKey;
decrypted_payload : TRawBytes;
+ LPayload : TOperationPayload;
+ s : String;
+ Lpasswords : TList;
Begin
- Result := false;
- if Length(RawEncryptedPayload)=0 then begin
- GetResultObject.GetAsVariant('result').Value:= False;
- GetResultObject.GetAsVariant('enc_payload').Value:= '';
- Result := true;
- exit;
+ if Length(params.AsString('payload',''))=0 then begin
+ ErrorNum:= CT_RPC_ErrNum_InvalidData;
+ ErrorDesc := 'Need param "payload"';
+ Exit(False);
end;
- for i := 0 to _RPCServer.WalletKeys.Count - 1 do begin
- pkey := _RPCServer.WalletKeys.Key[i].PrivateKey;
- if (assigned(pkey)) then begin
- if TPCEncryption.DoPascalCoinECIESDecrypt(pkey.PrivateKey,RawEncryptedPayload,decrypted_payload) then begin
- GetResultObject.GetAsVariant('result').Value:= true;
- GetResultObject.GetAsVariant('enc_payload').Value:= TCrypto.ToHexaString(RawEncryptedPayload);
- GetResultObject.GetAsVariant('unenc_payload').Value:= decrypted_payload.ToPrintable;
- GetResultObject.GetAsVariant('unenc_hexpayload').Value:= TCrypto.ToHexaString(decrypted_payload);
- GetResultObject.GetAsVariant('payload_method').Value:= 'key';
- GetResultObject.GetAsVariant('enc_pubkey').Value:= TCrypto.ToHexaString(TAccountComp.AccountKey2RawString(pkey.PublicKey));
- Result := true;
- Exit;
- end;
- end;
+ LPayload.payload_raw := TCrypto.HexaToRaw(params.AsString('payload',''));
+ LPayload.payload_type := params.AsInteger('payload_type',0);
+ if Length(LPayload.payload_raw)=0 then begin
+ ErrorNum:= CT_RPC_ErrNum_InvalidData;
+ ErrorDesc := '"payload" param is not an HEXASTRING';
+ Exit(False);
end;
- for i := 0 to jsonArrayPwds.Count - 1 do begin
- if TPCEncryption.DoPascalCoinAESDecrypt(RawEncryptedPayload,TEncoding.ANSI.GetBytes(jsonArrayPwds.GetAsVariant(i).AsString('')),decrypted_payload) then begin
- GetResultObject.GetAsVariant('result').Value:= true;
- GetResultObject.GetAsVariant('enc_payload').Value:= TCrypto.ToHexaString(RawEncryptedPayload);
- GetResultObject.GetAsVariant('unenc_payload').Value:= decrypted_payload.ToPrintable;
- GetResultObject.GetAsVariant('unenc_hexpayload').Value:= TCrypto.ToHexaString(decrypted_payload);
- GetResultObject.GetAsVariant('payload_method').Value:= 'pwd';
- GetResultObject.GetAsVariant('pwd').Value:= jsonArrayPwds.GetAsVariant(i).AsString('');
- Result := true;
- exit;
+ Lpasswords := TList.Create;
+ Try
+ for i := 0 to jsonArrayPwds.Count-1 do begin
+ s := jsonArrayPwds.GetAsVariant(i).AsString('');
+ if Lpasswords.IndexOf(s)<0 then Lpasswords.Add(s);
end;
- end;
- // Not found
- GetResultObject.GetAsVariant('result').Value:= False;
- GetResultObject.GetAsVariant('enc_payload').Value:= TCrypto.ToHexaString(RawEncryptedPayload);
+
+ if TPascalCoinJSONComp.FillEPasaOrDecrypt(-1,LPayload,FNode,FRPCServer.WalletKeys,Lpasswords,GetResultObject) then begin
+ GetResultObject.GetAsVariant('result').Value:= True;
+ end else begin
+ GetResultObject.GetAsVariant('result').Value:= False;
+ end;
+ GetResultObject.GetAsVariant('enc_payload').Value:= TCrypto.ToHexaString(LPayload.payload_raw);
+
+ Finally
+ Lpasswords.Free;
+ End;
+
Result := true;
End;
@@ -1909,7 +2257,7 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
// If using 'dest', only will apply if there is a fixed new public key, otherwise will use current public key of account
aux_target_pubkey := new_account_pubkey;
end else aux_target_pubkey := account_signer_pubkey;
- if Not TPascalCoinJSONComp.CheckAndGetEncodedRAWPayload(RawPayload,Payload_method,EncodePwd,account_signer_pubkey,aux_target_pubkey,LOpPayload,ErrorNum,ErrorDesc) then Exit(Nil);
+ if Not TPascalCoinJSONComp.CheckAndGetEncodedRAWPayload(RawPayload,[ptNonDeterministic],Payload_method,EncodePwd,account_signer_pubkey,aux_target_pubkey,LOpPayload,ErrorNum,ErrorDesc) then Exit(Nil);
Result := TOpChangeAccountInfo.CreateChangeAccountInfo(current_protocol,
account_signer,account_last_n_operation+1,account_target,
privateKey,
@@ -2257,7 +2605,7 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
OperationsHashTree.Free;
end;
finally
- FNode.OperationSequenceLock.Acquire;
+ FNode.OperationSequenceLock.Release;
end;
End;
@@ -2360,10 +2708,12 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
function FindNOperations : Boolean;
Var oprl : TOperationsResumeList;
start_block, account, n_operation_min, n_operation_max : Cardinal;
- sor : TSearchOperationResult;
+ sor : TSearchOpHashResult;
jsonarr : TPCJSONArray;
i : Integer;
begin
+ FNode.OperationSequenceLock.Acquire; // Added to prevent high concurrent API calls
+ try
Result := False;
oprl := TOperationsResumeList.Create;
try
@@ -2381,13 +2731,13 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
start_block := params.AsCardinal('start_block',0); // Optional: 0 = Search all
sor := FNode.FindNOperations(account,start_block,true,n_operation_min,n_operation_max,oprl);
Case sor of
- found : Result := True;
- invalid_params : begin
+ OpHash_found : Result := True;
+ OpHash_invalid_params : begin
ErrorNum:=CT_RPC_ErrNum_NotFound;
ErrorDesc:='Not found using block/account/n_operation';
exit;
end;
- blockchain_block_not_found : begin
+ OpHash_block_not_found : begin
ErrorNum := CT_RPC_ErrNum_InvalidBlock;
ErrorDesc:='Blockchain file does not contain all blocks to find';
exit;
@@ -2397,12 +2747,15 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
jsonarr := jsonresponse.GetAsArray('result');
if oprl.Count>0 then begin;
for i:=0 to oprl.Count-1 do begin
- FillOperationResumeToJSONObject(oprl.OperationResume[i],jsonarr.GetAsObject(jsonarr.Count));
+ FillOperationResumeToJSONObject(oprl.Items[i],jsonarr.GetAsObject(jsonarr.Count));
end;
end;
finally
oprl.Free;
end;
+ finally
+ FNode.OperationSequenceLock.Release;
+ end;
end;
function MultiOperationAddOperation(Const HexaStringOperationsHashTree : String) : boolean;
@@ -2413,6 +2766,45 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
Result := FNode.GetMempoolAccount( nAccount );
end;
+ Function TryCaptureEPASA(const AJSONObj : TPCJSONObject; out AAccount : Cardinal; out AErrorNum : Integer; out AErrorDesc : String) : Boolean;
+ var LEPasa : TEPasa;
+ begin
+ // Parse EPASA
+ if NOT TEPasa.TryParse(AJSONObj.AsString('account',''), LEPasa) then begin
+ AErrorNum := CT_RPC_ErrNum_InvalidData;
+ AErrorDesc := 'Field "account" missing or invalid EPASA format';
+ Exit(False);
+ end;
+
+ // Resolve EPASA (note: PayToKey returns error in this resolution method)
+ if NOT FNode.TryResolveEPASA(LEPasa, AAccount, AErrorDesc) then begin
+ AErrorNum := CT_RPC_ErrNum_InvalidEPASA;
+ Exit(False);
+ end;
+
+ // Payload override
+ if LEPasa.HasPayload then begin
+ // Only support public payloads for now
+ if NOT LEPasa.PayloadType.HasTrait(ptPublic) then begin
+ AErrorNum := CT_RPC_ErrNum_NotImplemented;
+ AErrorDesc := 'Encrypted payloads not currently supported in DATA operation';
+ Exit(false);
+ end;
+
+ // Ensure no ambiguity with payload arguments
+ if AJSONObj.HasValue('payload') OR AJSONObj.HasValue('payload_type') then begin
+ AErrorNum := CT_RPC_ErrNum_AmbiguousPayload;
+ AErrorDesc := 'Ambiguous Payload between EPASA and method arguments';
+ Exit(False);
+ end;
+ // Override the JSON args (processed later by caller)
+ AJSONObj.GetAsVariant('payload').Value := LEPasa.GetRawPayloadBytes.ToHexaString;
+ AJSONObj.GetAsVariant('payload_type').Value := LEPasa.PayloadType.ToProtocolValue;
+ end;
+ AAccount := LEPasa.Account.Value;
+ Result := True;
+ end;
+
var errors : String;
OperationsHashTree : TOperationsHashTree;
jsonArr : TPCJSONArray;
@@ -2421,6 +2813,7 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
receiver : TMultiOpReceiver;
changeinfo : TMultiOpChangeInfo;
mop : TOpMultiOperation;
+ LEPASA : TEPasa;
begin
{ This will ADD or UPDATE a MultiOperation with NEW field/s
- UPDATE: If LAST operation in HexaStringOperationsHashTree RAW value contains a MultiOperation
@@ -2448,7 +2841,7 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
}
Result := false;
if Not HexaStringToOperationsHashTreeAndGetMultioperation(
- Self.FNode.Bank.SafeBox.CurrentProtocol, // HS: 2019-07-09: use current protocol since this API used to build new unpublished operations, not historical ones
+ Self.FNode.Bank.SafeBox.CurrentProtocol,
HexaStringOperationsHashTree,True,OperationsHashTree,mop,errors) then begin
ErrorNum:=CT_RPC_ErrNum_InvalidData;
ErrorDesc:= 'Error decoding param previous operations hash tree raw value: '+errors;
@@ -2459,11 +2852,8 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
jsonArr := params.GetAsArray('senders');
for i:=0 to jsonArr.Count-1 do begin
sender := CT_TMultiOpSender_NUL;
- if not TAccountComp.AccountTxtNumberToAccountNumber(jsonArr.GetAsObject(i).AsString('account',''),sender.Account) then begin
- ErrorNum := CT_RPC_ErrNum_InvalidData;
- ErrorDesc := 'Field "account" for "senders" array not found at senders['+IntToStr(i)+']';
+ if NOT TryCaptureEPASA(jsonArr.GetAsObject(i), sender.Account, ErrorNum, ErrorDesc) then
Exit;
- end;
sender.Amount:= ToPascalCoins(jsonArr.GetAsObject(i).AsDouble('amount',0));
sender.N_Operation:=jsonArr.GetAsObject(i).AsInteger('n_operation',0);
// Update N_Operation with valid info
@@ -2481,11 +2871,8 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
jsonArr := params.GetAsArray('receivers');
for i:=0 to jsonArr.Count-1 do begin
receiver := CT_TMultiOpReceiver_NUL;
- if not TAccountComp.AccountTxtNumberToAccountNumber(jsonArr.GetAsObject(i).AsString('account',''),receiver.Account) then begin
- ErrorNum := CT_RPC_ErrNum_InvalidData;
- ErrorDesc := 'Field "account" for "receivers" array not found at receivers['+IntToStr(i)+']';
+ if NOT TryCaptureEPASA(jsonArr.GetAsObject(i), receiver.Account, ErrorNum, ErrorDesc) then
Exit;
- end;
receiver.Amount:= ToPascalCoins(jsonArr.GetAsObject(i).AsDouble('amount',0));
receiver.Payload.payload_raw:=TCrypto.HexaToRaw(jsonArr.GetAsObject(i).AsString('payload',''));
receiver.Payload.payload_type := jsonArr.GetAsObject(i).AsInteger('payload_type',CT_TOperationPayload_NUL.payload_type);
@@ -2543,7 +2930,7 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
end;
end;
// Return multioperation object:
- TPascalCoinJSONComp.FillMultiOperationObject(FNode.Bank.SafeBox.CurrentProtocol,mop,GetResultObject);
+ TPascalCoinJSONComp.FillMultiOperationObject(FNode.Bank.SafeBox.CurrentProtocol,mop,FNode,FRPCServer.WalletKeys,FRPCServer.PayloadPasswords, GetResultObject);
finally
OperationsHashTree.Free;
end;
@@ -2680,7 +3067,7 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
Try
InternalMultiOperationSignCold(mop,protocol,params.GetAsArray('accounts_and_keys'),j);
// Return multioperation object:
- TPascalCoinJSONComp.FillMultiOperationObject(protocol,mop,GetResultObject);
+ TPascalCoinJSONComp.FillMultiOperationObject(protocol,mop,FNode,FRPCServer.WalletKeys,FRPCServer.PayloadPasswords,GetResultObject);
Result := True;
finally
senderOperationsHashTree.Free;
@@ -2731,7 +3118,7 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
lSigners.Free;
end;
// Return multioperation object:
- TPascalCoinJSONComp.FillMultiOperationObject(FNode.Bank.SafeBox.CurrentProtocol,mop,GetResultObject);
+ TPascalCoinJSONComp.FillMultiOperationObject(FNode.Bank.SafeBox.CurrentProtocol,mop,FNode,FRPCServer.WalletKeys,FRPCServer.PayloadPasswords,GetResultObject);
Result := True;
finally
senderOperationsHashTree.Free;
@@ -2780,6 +3167,7 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
jsonarr : TPCJSONArray;
jso : TPCJSONObject;
LRPCProcessMethod : TRPCProcessMethod;
+ LAccountsList : TList;
begin
_ro := Nil;
_ra := Nil;
@@ -2796,10 +3184,17 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
Exit;
end;
TNode.DecodeIpStringToNodeServerAddressArray(params.AsString('nodes',''),nsaarr);
+ ansistr := '';
for i:=low(nsaarr) to high(nsaarr) do begin
TNetData.NetData.AddServer(nsaarr[i]);
+ if (params.AsBoolean('whitelist',false)) then begin
+ ansistr := ansistr + ';' + nsaarr[i].ip;
+ end;
end;
jsonresponse.GetAsVariant('result').Value:=length(nsaarr);
+ if (ansistr<>'') then begin
+ self.RPCServer.ValidIPs := self.RPCServer.ValidIPs + ';' + ansistr;
+ end;
Result := true;
end else if (method='getaccount') then begin
// Param "account" contains account number
@@ -2834,13 +3229,16 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
Lanl := _RPCServer.WalletKeys.AccountsKeyList.AccountKeyList[i];
k := params.AsInteger('max',100);
l := params.AsInteger('start',0);
- for j := 0 to Lanl.Count - 1 do begin
- if (j>=l) then begin
- account := FNode.GetMempoolAccount(Lanl.Get(j));
+ LAccountsList := TList.Create;
+ Try
+ Lanl.FillList(l,k,LAccountsList);
+ for j := 0 to LAccountsList.Count - 1 do begin
+ account := FNode.GetMempoolAccount(LAccountsList[j]);
TPascalCoinJSONComp.FillAccountObject(account,jsonarr.GetAsObject(jsonarr.Count));
end;
- if (k>0) And ((j+1)>=(k+l)) then break;
- end;
+ Finally
+ LAccountsList.Free;
+ End;
Result := true;
end else begin
k := params.AsInteger('max',100);
@@ -2848,14 +3246,20 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
c := 0;
for i:=0 to _RPCServer.WalletKeys.AccountsKeyList.Count-1 do begin
Lanl := _RPCServer.WalletKeys.AccountsKeyList.AccountKeyList[i];
- for j := 0 to Lanl.Count - 1 do begin
- if (c>=l) then begin
- account := FNode.GetMempoolAccount(Lanl.Get(j));
- TPascalCoinJSONComp.FillAccountObject(account,jsonarr.GetAsObject(jsonarr.Count));
+ LAccountsList := TList