diff --git a/explorer/src/Pos/Explorer/Aeson/ClientTypes.hs b/explorer/src/Pos/Explorer/Aeson/ClientTypes.hs index d035fa7a33e..ce4e8137973 100644 --- a/explorer/src/Pos/Explorer/Aeson/ClientTypes.hs +++ b/explorer/src/Pos/Explorer/Aeson/ClientTypes.hs @@ -19,7 +19,7 @@ import Pos.Explorer.Web.ClientTypes (CAda (..), CAddress, CAddressSummary, CAddressType, CBlockEntry, CBlockSummary, CByteString (..), CCoin, CGenesisAddressInfo, CGenesisSummary, CHash, CNetworkAddress, CTxBrief, - CTxEntry, CTxId, CTxSummary, CUtxo) + CTxEntry, CTxId, CTxSummary, CUtxo, CBlockRange) import Pos.Explorer.Web.Error (ExplorerError) deriveJSON defaultOptions ''CHash @@ -35,6 +35,7 @@ deriveToJSON defaultOptions ''CAddressType deriveToJSON defaultOptions ''CAddressSummary deriveToJSON defaultOptions ''CBlockSummary deriveToJSON defaultOptions ''CNetworkAddress +deriveToJSON defaultOptions ''CBlockRange deriveToJSON defaultOptions ''CTxSummary deriveToJSON defaultOptions ''CGenesisSummary deriveToJSON defaultOptions ''CGenesisAddressInfo diff --git a/explorer/src/Pos/Explorer/Web/Api.hs b/explorer/src/Pos/Explorer/Web/Api.hs index b2a1042555e..e7fb81d3027 100644 --- a/explorer/src/Pos/Explorer/Web/Api.hs +++ b/explorer/src/Pos/Explorer/Web/Api.hs @@ -24,7 +24,7 @@ import Pos.Core (EpochIndex) import Pos.Explorer.Web.ClientTypes (Byte, CAda, CAddress, CAddressSummary, CAddressesFilter, CBlockEntry, CBlockSummary, CGenesisAddressInfo, CGenesisSummary, - CHash, CTxBrief, CTxEntry, CTxId, CTxSummary, CUtxo) + CHash, CTxBrief, CTxEntry, CTxId, CTxSummary, CUtxo, CBlockRange) import Pos.Explorer.Web.Error (ExplorerError) import Pos.Util.Servant (DQueryParam, ModifiesApiRes (..), VerbMod) @@ -71,6 +71,14 @@ data ExplorerApiRecord route = ExplorerApiRecord :> QueryParam "pageSize" Word :> ExRes Get (PageNumber, [CBlockEntry]) + , _dumpBlockRange :: route + :- Summary "Dump a range of blocks, including all tx in those blocks" + :> "blocks" + :> "range" + :> Capture "start" CHash + :> Capture "stop" CHash + :> ExRes Get CBlockRange + , _blocksPagesTotal :: route :- Summary "Get the list of total pages." :> "blocks" diff --git a/explorer/src/Pos/Explorer/Web/ClientTypes.hs b/explorer/src/Pos/Explorer/Web/ClientTypes.hs index 9215402870a..f217765f477 100644 --- a/explorer/src/Pos/Explorer/Web/ClientTypes.hs +++ b/explorer/src/Pos/Explorer/Web/ClientTypes.hs @@ -21,6 +21,7 @@ module Pos.Explorer.Web.ClientTypes , CUtxo (..) , CNetworkAddress (..) , CTxSummary (..) + , CBlockRange (..) , CGenesisSummary (..) , CGenesisAddressInfo (..) , CAddressesFilter (..) @@ -80,7 +81,7 @@ import Pos.Core (Address, Coin, EpochIndex, LocalSlotIndex, SlotCount, coinToInteger, decodeTextAddress, getEpochIndex, getSlotIndex, mkCoin, sumCoins, timestampToPosix, unsafeAddCoin, unsafeGetCoin, unsafeIntegerToCoin, - unsafeSubCoin) + unsafeSubCoin, difficultyL) import Pos.Core.Merkle (getMerkleRoot, mkMerkleTree, mtRoot) import Pos.Crypto (AbstractHash, Hash, HashAlgorithm, hash) import qualified Pos.DB.Lrc as LrcDB (getLeader) @@ -196,6 +197,7 @@ instance Show CAda where data CBlockEntry = CBlockEntry { cbeEpoch :: !Word64 , cbeSlot :: !Word16 + , cbeBlkHeight :: !Word , cbeBlkHash :: !CHash , cbeTimeIssued :: !(Maybe POSIXTime) , cbeTxNum :: !Word @@ -227,6 +229,7 @@ toBlockEntry epochSlots (blk, Undo{..}) = do -- Fill required fields for @CBlockEntry@ let cbeEpoch = getEpochIndex epochIndex cbeSlot = getSlotIndex slotIndex + cbeBlkHeight = fromIntegral $ blk ^. difficultyL cbeBlkHash = toCHash $ headerHash blk cbeTimeIssued = timestampToPosix <$> blkSlotStart txs = toList $ blk ^. mainBlockTxPayload . txpTxs @@ -267,6 +270,12 @@ toTxEntry ts tx = CTxEntry {..} cteTimeIssued = timestampToPosix <$> ts cteAmount = mkCCoin $ totalTxOutMoney tx + +data CBlockRange = CBlockRange + { cbrBlocks :: [CBlockSummary] + , cbrTransactions :: [CTxSummary] + } deriving (Show, Generic) + -- | Data displayed on block summary page data CBlockSummary = CBlockSummary { cbsEntry :: !CBlockEntry diff --git a/explorer/src/Pos/Explorer/Web/Server.hs b/explorer/src/Pos/Explorer/Web/Server.hs index a8c99f61d16..9ebcb41897b 100644 --- a/explorer/src/Pos/Explorer/Web/Server.hs +++ b/explorer/src/Pos/Explorer/Web/Server.hs @@ -51,7 +51,7 @@ import Servant.Server.Generic (AsServerT) import Pos.Crypto (WithHash (..), hash, redeemPkBuild, withHash) -import Pos.DB.Block (getBlund) +import Pos.DB.Block (getBlund, resolveForwardLink) import Pos.DB.Class (MonadDBRead) import Pos.Infra.Diffusion.Types (Diffusion) @@ -59,7 +59,7 @@ import Pos.Infra.Diffusion.Types (Diffusion) import Pos.Binary.Class (biSize) import Pos.Chain.Block (Block, Blund, HeaderHash, MainBlock, Undo, gbHeader, gbhConsensus, mainBlockSlot, mainBlockTxPayload, - mcdSlot) + mcdSlot, headerHash) import Pos.Chain.Genesis as Genesis (Config (..), GenesisHash, configEpochSlots) import Pos.Chain.Txp (Tx (..), TxAux, TxId, TxIn (..), TxMap, @@ -94,7 +94,7 @@ import Pos.Explorer.Web.ClientTypes (Byte, CAda (..), CAddress (..), CAddressesFilter (..), CBlockEntry (..), CBlockSummary (..), CByteString (..), CGenesisAddressInfo (..), CGenesisSummary (..), CHash, - CTxBrief (..), CTxEntry (..), CTxId (..), CTxSummary (..), + CTxBrief (..), CTxEntry (..), CTxId (..), CTxSummary (..), CBlockRange (..), CUtxo (..), TxInternal (..), convertTxOutputs, convertTxOutputsMB, fromCAddress, fromCHash, fromCTxId, getEpochIndex, getSlotIndex, mkCCoin, mkCCoinMB, @@ -135,6 +135,7 @@ explorerHandlers genesisConfig _diffusion = toServant (ExplorerApiRecord { _totalAda = getTotalAda , _blocksPages = getBlocksPage epochSlots + , _dumpBlockRange = getBlockRange genesisConfig , _blocksPagesTotal = getBlocksPagesTotal , _blocksSummary = getBlockSummary genesisConfig , _blocksTxs = getBlockTxs genesisHash @@ -323,8 +324,8 @@ getBlockSummary -> CHash -> m CBlockSummary getBlockSummary genesisConfig cHash = do - headerHash <- unwrapOrThrow $ fromCHash cHash - mainBlund <- getMainBlund (configGenesisHash genesisConfig) headerHash + hh <- unwrapOrThrow $ fromCHash cHash + mainBlund <- getMainBlund (configGenesisHash genesisConfig) hh toBlockSummary (configEpochSlots genesisConfig) mainBlund @@ -430,6 +431,85 @@ getAddressUtxoBulk nm cAddrs = do cuBs = CByteString bs } +getBlockRange + :: ExplorerMode ctx m + => Genesis.Config + -> CHash + -> CHash + -> m CBlockRange +getBlockRange genesisConfig start stop = do + startHeaderHash <- unwrapOrThrow $ fromCHash start + stopHeaderHash <- unwrapOrThrow $ fromCHash stop + let + getTxSummaryFromBlock + :: (ExplorerMode ctx m) + => MainBlock + -> Tx + -> m CTxSummary + getTxSummaryFromBlock mb tx = do + let txId = hash tx + txExtra <- getTxExtraOrFail txId + + blkSlotStart <- getBlkSlotStart mb + + let + blockTime = timestampToPosix <$> blkSlotStart + inputOutputsMB = map (fmap toaOut) $ NE.toList $ teInputOutputs txExtra + txOutputs = convertTxOutputs . NE.toList $ _txOutputs tx + totalInputMB = unsafeIntegerToCoin . sumCoins . map txOutValue <$> sequence inputOutputsMB + totalOutput = unsafeIntegerToCoin $ sumCoins $ map snd txOutputs + + -- Verify that strange things don't happen with transactions + whenJust totalInputMB $ \totalInput -> when (totalOutput > totalInput) $ + throwM $ Internal "Detected tx with output greater than input" + + pure $ CTxSummary + { ctsId = toCTxId txId + , ctsTxTimeIssued = timestampToPosix <$> teReceivedTime txExtra + , ctsBlockTimeIssued = blockTime + , ctsBlockHeight = Nothing + , ctsBlockEpoch = Nothing + , ctsBlockSlot = Nothing + , ctsBlockHash = Just $ toCHash $ headerHash mb + , ctsRelayedBy = Nothing + , ctsTotalInput = mkCCoinMB totalInputMB + , ctsTotalOutput = mkCCoin totalOutput + , ctsFees = mkCCoinMB $ (`unsafeSubCoin` totalOutput) <$> totalInputMB + , ctsInputs = map (fmap (second mkCCoin)) $ convertTxOutputsMB inputOutputsMB + , ctsOutputs = map (second mkCCoin) txOutputs + } + genesisHash = configGenesisHash genesisConfig + go :: ExplorerMode ctx m => HeaderHash -> CBlockRange -> m CBlockRange + go hh state1 = do + maybeBlund <- getBlund genesisHash hh + newState <- case maybeBlund of + Just (Right blk', undo) -> do + let + txs :: [Tx] + txs = blk' ^. mainBlockTxPayload . txpTxs + blockSum <- toBlockSummary (configEpochSlots genesisConfig) (blk',undo) + let + state2 = state1 { cbrBlocks = blockSum : (cbrBlocks state1) } + iterateTx :: ExplorerMode ctx m => CBlockRange -> Tx -> m CBlockRange + iterateTx stateIn tx = do + txSummary <- getTxSummaryFromBlock blk' tx + pure $ stateIn { cbrTransactions = txSummary : (cbrTransactions stateIn) } + foldM iterateTx state2 txs + _ -> pure state1 + if hh == stopHeaderHash then + pure newState + else do + nextHh <- resolveForwardLink hh + case nextHh of + Nothing -> do + pure newState + Just nextHh' -> go nextHh' newState + backwards <- go startHeaderHash (CBlockRange [] []) + pure $ CBlockRange + { cbrBlocks = reverse $ cbrBlocks backwards + , cbrTransactions = reverse $ cbrTransactions backwards + } + -- | Get transaction summary from transaction id. Looks at both the database -- and the memory (mempool) for the transaction. What we have at the mempool @@ -884,9 +964,8 @@ getBlundOrThrow :: ExplorerMode ctx m => HeaderHash -> m Blund -getBlundOrThrow headerHash = - getBlundFromHHCSLI headerHash >>= - maybeThrow (Internal "Blund with hash cannot be found!") +getBlundOrThrow hh = + getBlundFromHHCSLI hh >>= maybeThrow (Internal "Blund with hash cannot be found!") -- | Deserialize Cardano or RSCoin address and convert it to Cardano address. diff --git a/explorer/src/Pos/Explorer/Web/TestServer.hs b/explorer/src/Pos/Explorer/Web/TestServer.hs index 0e2b883b124..784b6365710 100644 --- a/explorer/src/Pos/Explorer/Web/TestServer.hs +++ b/explorer/src/Pos/Explorer/Web/TestServer.hs @@ -24,6 +24,7 @@ import Pos.Explorer.Web.ClientTypes (Byte, CAda (..), CAddress (..), CAddressSummary (..), CAddressType (..), CAddressesFilter (..), CBlockEntry (..), CBlockSummary (..), CGenesisAddressInfo (..), + CBlockRange (..), CGenesisSummary (..), CHash (..), CTxBrief (..), CTxEntry (..), CTxId (..), CTxSummary (..), CUtxo (..), mkCCoin) @@ -50,6 +51,7 @@ explorerHandlers :: Server ExplorerApi explorerHandlers = toServant (ExplorerApiRecord { _totalAda = testTotalAda + , _dumpBlockRange = testDumpBlockRange , _blocksPages = testBlocksPages , _blocksPagesTotal = testBlocksPagesTotal , _blocksSummary = testBlocksSummary @@ -114,6 +116,15 @@ testBlocksPagesTotal -> Handler Integer testBlocksPagesTotal _ = pure 10 +testDumpBlockRange :: CHash -> CHash -> Handler CBlockRange +testDumpBlockRange start _ = do + dummyBlock <- testBlocksSummary start + dummyTx <- testTxsSummary cTxId + pure $ CBlockRange + { cbrBlocks = [ dummyBlock ] + , cbrTransactions = [ dummyTx ] + } + testBlocksPages :: Maybe Word -> Maybe Word @@ -121,6 +132,7 @@ testBlocksPages testBlocksPages _ _ = pure (1, [CBlockEntry { cbeEpoch = 37294 , cbeSlot = 10 + , cbeBlkHeight = 1564738 , cbeBlkHash = CHash "75aa93bfa1bf8e6aa913bc5fa64479ab4ffc1373a25c8176b61fa1ab9cbae35d" , cbeTimeIssued = Just posixTime , cbeTxNum = 0 @@ -137,6 +149,7 @@ testBlocksSummary _ = pure CBlockSummary { cbsEntry = CBlockEntry { cbeEpoch = 37294 , cbeSlot = 10 + , cbeBlkHeight = 1564738 , cbeBlkHash = CHash "75aa93bfa1bf8e6aa913bc5fa64479ab4ffc1373a25c8176b61fa1ab9cbae35d" , cbeTimeIssued = Just posixTime , cbeTxNum = 0 @@ -213,6 +226,7 @@ testEpochSlotSearch (EpochIndex 1) 2 = testEpochSlotSearch _ _ = pure [CBlockEntry { cbeEpoch = 37294 , cbeSlot = 10 + , cbeBlkHeight = 1564738 , cbeBlkHash = CHash "75aa93bfa1bf8e6aa913bc5fa64479ab4ffc1373a25c8176b61fa1ab9cbae35d" , cbeTimeIssued = Just posixTime , cbeTxNum = 0 @@ -229,6 +243,7 @@ testEpochPageSearch testEpochPageSearch _ _ = pure (1, [CBlockEntry { cbeEpoch = 37294 , cbeSlot = 10 + , cbeBlkHeight = 1564738 , cbeBlkHash = CHash "75aa93bfa1bf8e6aa913bc5fa64479ab4ffc1373a25c8176b61fa1ab9cbae35d" , cbeTimeIssued = Just posixTime , cbeTxNum = 0 diff --git a/explorer/src/documentation/Main.hs b/explorer/src/documentation/Main.hs index ab33cc0ac2d..a431e8d83b3 100644 --- a/explorer/src/documentation/Main.hs +++ b/explorer/src/documentation/Main.hs @@ -84,6 +84,7 @@ instance ToSchema C.CAddress instance ToParamSchema C.CAddress instance ToParamSchema C.EpochIndex instance ToSchema C.CTxSummary +instance ToSchema C.CBlockRange instance ToSchema C.CTxEntry instance ToSchema C.CTxBrief instance ToSchema C.CUtxo