Add TStorage.GetBlockInformation

src/core/UAccounts.pas

@@ -465,9 +465,12 @@ Type
   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;
@@ -1158,6 +1161,30 @@ begin
   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));
@@ -1199,6 +1226,29 @@ begin
   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';
 
@@ -2219,11 +2269,11 @@ begin
     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);
@@ -4592,11 +4642,11 @@ begin
     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);
@@ -4610,7 +4660,7 @@ end;
 
 function TPCSafeBox.GetAccount(AAccountNumber: Integer; var AAccount: TAccount): Boolean;
 begin
-  AAccount := Account(AAccountNumber);
+  AAccount := Account(AAccountNumber).GetCopy;
   Result := True;
 end;
 

src/core/UBlockChain.pas

@@ -275,6 +275,7 @@ Type
     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;
@@ -419,6 +420,7 @@ Type
     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;
@@ -493,7 +495,7 @@ Type
     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 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;
@@ -502,6 +504,7 @@ Type
     Procedure DoEraseStorage; virtual; abstract;
     Procedure DoSavePendingBufferOperations(OperationsHashTree : TOperationsHashTree); virtual; abstract;
     Procedure DoLoadPendingBufferOperations(OperationsHashTree : TOperationsHashTree); virtual; abstract;
+    Function DoGetBlockInformation(const ABlock : Integer; var AOperationBlock : TOperationBlock; var AOperationsCount : Integer; var AVolume : Int64) : Boolean; virtual;
   public
     Function LoadBlockChainBlock(Operations : TPCOperationsComp; Block : Cardinal) : Boolean;
     Function SaveBlockChainBlock(Operations : TPCOperationsComp) : Boolean;
@@ -518,6 +521,9 @@ Type
     Procedure SavePendingBufferOperations(OperationsHashTree : TOperationsHashTree);
     Procedure LoadPendingBufferOperations(OperationsHashTree : TOperationsHashTree);
     Function BlockExists(Block : Cardinal) : Boolean;
+
+    function Orphan : String;
+    Function GetBlockInformation(const ABlock : Integer; var AOperationBlock : TOperationBlock; var AOperationsCount : Integer; var AVolume : Int64) : Boolean;
   End;
 
   TStorageClass = Class of TStorage;
@@ -1724,7 +1730,7 @@ begin
       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;
@@ -2316,6 +2322,11 @@ begin
   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);
@@ -3250,6 +3261,28 @@ begin
   DoDeleteBlockChainBlocks(StartingDeleteBlock);
 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;
+    AOperationBlock := LPCOperations.OperationBlock.GetCopy;
+    AOperationsCount := LPCOperations.Count;
+    AVolume := LPCOperations.OperationsHashTree.TotalAmount;
+  Finally
+    LPCOperations.Free;
+  End;
+end;
+
 function TStorage.Initialize: Boolean;
 begin
   Result := DoInitialize;
@@ -3261,6 +3294,13 @@ begin
   DoEraseStorage;
 end;
 
+function TStorage.GetBlockInformation(const ABlock: Integer;
+  var AOperationBlock: TOperationBlock; var AOperationsCount: Integer;
+  var AVolume: Int64): Boolean;
+begin
+  Result := DoGetBlockInformation(ABlock,AOperationBlock,AOperationsCount,AVolume);
+end;
+
 procedure TStorage.SavePendingBufferOperations(OperationsHashTree : TOperationsHashTree);
 begin
   DoSavePendingBufferOperations(OperationsHashTree);
@@ -3278,11 +3318,82 @@ begin
 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);
+    // 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.Orphan: String;
+begin
+  if Assigned(Bank) then Result := Bank.Orphan
+  else Result := '';
 end;
 
 function TStorage.SaveBlockChainBlock(Operations: TPCOperationsComp): Boolean;
@@ -3319,6 +3430,29 @@ begin
   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;
@@ -3931,7 +4065,7 @@ begin
   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;

src/core/UFileStorage.pas

@@ -60,7 +60,7 @@ Type
     procedure SetReadOnly(const Value: Boolean); 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 DoMoveBlockChain(Start_Block : Cardinal; Const DestOrphan : TOrphan) : Boolean; override;
     Procedure DoDeleteBlockChainBlocks(StartingDeleteBlock : Cardinal); override;
     Function DoBlockExists(Block : Cardinal) : Boolean; override;
     Function LockBlockChainStream : TFileStream;
@@ -342,50 +342,19 @@ Begin
   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 := 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
-            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.Bank := Self.Bank;
-        db.FStreamFirstBlockNumber := Start_Block;
-      end;
-      if db is TFileStorage then TFileStorage(db).LockBlockChainStream;
+      db.Bank := Self.Bank;
+      db.FStreamFirstBlockNumber := Start_Block;
+      db.FBlockChainFileName := TPCBank.GetStorageFolder(DestOrphan)+PathDelim+'BlockChainStream.blocks';
+      db.LockBlockChainStream;
       try
         db.FIsMovingBlockchain:=True;
         ops := TPCOperationsComp.Create(Nil);
@@ -400,16 +369,12 @@ begin
         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 (Bank.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
@@ -680,7 +645,7 @@ begin
       if FBlockChainFileName<>'' then begin
         fn := FBlockChainFileName
       end else begin
-        fn := Bank.GetStorageFolder(Bank.Orphan)+PathDelim+'BlockChainStream.blocks';
+        fn := TPCBank.GetStorageFolder(Orphan)+PathDelim+'BlockChainStream.blocks';
       end;
       exists := FileExists(fn);
       if ReadOnly then begin

src/core/URPC.pas

@@ -186,11 +186,11 @@ var _RPCServer : TRPCServer = Nil;
 { 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;
@@ -213,12 +213,10 @@ begin
     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;
-  finally
-    pcops.Free;
-  end;
 end;
 
 class function TPascalCoinJSONComp.FillEPasaOrDecrypt(const AAccount: Int64;