From c9aaf13492ae1f7a3260d20bfcaa82a611a72c3d Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Thu, 16 Jan 2020 17:49:56 +1100 Subject: [PATCH] webap: Fix /api/blocks/txs/{blkHash} endpoint The DB query for this endpoint was buggy resulting in transactions outputs being duplicated across transactions. This would happen for a small percentage of block hashes. An example that does trigger this issue is: /api/blocks/txs/619457f25781b1c32c935e711a019d8c584574b363b27f3ae1393bddb895017a Closes: https://github.com/input-output-hk/cardano-explorer/issues/195 --- .../app/Explorer/Web/Validate.hs | 2 + .../app/Explorer/Web/Validate/BlockTx.hs | 34 ----- .../app/Explorer/Web/Validate/BlocksTxs.hs | 59 +++++++ .../app/Explorer/Web/Validate/Random.hs | 22 +-- .../cardano-explorer-webapi.cabal | 1 + cardano-explorer-webapi/src/Explorer/Web.hs | 7 +- .../src/Explorer/Web/Api/Legacy/BlocksTxs.hs | 144 +++++++++--------- .../src/Explorer/Web/ClientTypes.hs | 4 +- cardano-explorer/app/Explorer/Web/Validate.hs | 115 ++++++++++++++ 9 files changed, 271 insertions(+), 117 deletions(-) delete mode 100644 cardano-explorer-webapi/app/Explorer/Web/Validate/BlockTx.hs create mode 100644 cardano-explorer-webapi/app/Explorer/Web/Validate/BlocksTxs.hs create mode 100644 cardano-explorer/app/Explorer/Web/Validate.hs diff --git a/cardano-explorer-webapi/app/Explorer/Web/Validate.hs b/cardano-explorer-webapi/app/Explorer/Web/Validate.hs index 5ae580b..9dffc78 100644 --- a/cardano-explorer-webapi/app/Explorer/Web/Validate.hs +++ b/cardano-explorer-webapi/app/Explorer/Web/Validate.hs @@ -17,6 +17,7 @@ import Explorer.DB (readPGPassFileEnv, toConnectionString) import Explorer.Web.Api.Legacy.Util (textShow) import Explorer.Web.Validate.Address (validateAddressSummary, validateRedeemAddressSummary) +import Explorer.Web.Validate.BlocksTxs (validateBlocksTxs) import Explorer.Web.Validate.GenesisAddress (validateGenesisAddressPaging) runValidation :: Word -> IO () @@ -40,4 +41,5 @@ validate backend = do validateRedeemAddressSummary backend validateAddressSummary backend validateGenesisAddressPaging backend + validateBlocksTxs backend putStrLn "" diff --git a/cardano-explorer-webapi/app/Explorer/Web/Validate/BlockTx.hs b/cardano-explorer-webapi/app/Explorer/Web/Validate/BlockTx.hs deleted file mode 100644 index a6d0a2c..0000000 --- a/cardano-explorer-webapi/app/Explorer/Web/Validate/BlockTx.hs +++ /dev/null @@ -1,34 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Explorer.Web.Validate.Address - ( validateBlockTx - ) where - -import Control.Monad (when) -import Control.Monad.IO.Class (MonadIO, liftIO) - -import Data.Text.ANSI (green, red) -import qualified Data.Text.IO as Text - -import Database.Persist.Sql (SqlBackend) - -import Explorer.DB (LookupFail, renderLookupFail) - -import Explorer.Web (CAddress (..), CAddressSummary (..), CCoin (..), - queryAddressSummary, runQuery) -import Explorer.Web.Error (ExplorerError (..), renderExplorerError) -import Explorer.Web.Api.Legacy.Util (decodeTextAddress, textShow) -import Explorer.Web.Validate.Random (queryRandomBlockHash) - -import System.Exit (exitFailure) - --- | Validate that the total coin sent agrees when calling the SQL queries behind: --- /api/blocks/summary/{blkHash} --- /api/blocks/txs/{blkHash} - -validateBlockTx :: SqlBackend -> IO () -validateBlockTx backend = do - addrSum <- runQuery backend $ do - addrTxt <- handleLookupFail =<< queryRandomBlockHash - handleExplorerError =<< queryAddressSummary addrTxt addr - reportAddressSummary addrSum diff --git a/cardano-explorer-webapi/app/Explorer/Web/Validate/BlocksTxs.hs b/cardano-explorer-webapi/app/Explorer/Web/Validate/BlocksTxs.hs new file mode 100644 index 0000000..e7aed0c --- /dev/null +++ b/cardano-explorer-webapi/app/Explorer/Web/Validate/BlocksTxs.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} + +module Explorer.Web.Validate.BlocksTxs + ( validateBlocksTxs + ) where + +import qualified Data.List as List +import Data.Text (Text) +import qualified Data.Text as Text +import Data.Text.ANSI (green, red) +import qualified Data.Text.IO as Text + +import Database.Persist.Sql (SqlBackend) + +import Explorer.Web (CTxBrief (..), CTxBrief (..), queryBlocksTxs, runQuery) +import Explorer.Web.Api.Legacy.Util (bsBase16Encode) +import Explorer.Web.Validate.Random (queryRandomBlockHash) +import Explorer.Web.Validate.ErrorHandling (handleLookupFail, handleExplorerError) + + +import System.Exit (exitFailure) + +validateBlocksTxs :: SqlBackend -> IO () +validateBlocksTxs backend = do + (blkHash, txs) <- runQuery backend $ do + blkHash <- handleLookupFail =<< queryRandomBlockHash + (blkHash,) <$> (handleExplorerError =<< queryBlocksTxs blkHash 100 0) + + validateInputsUnique (bsBase16Encode blkHash) txs + validateOutputsUnique (bsBase16Encode blkHash) txs + +-- ------------------------------------------------------------------------------------------------- + +validateInputsUnique :: Text -> [CTxBrief] -> IO () +validateInputsUnique blkHash tabs = do + mapM_ Text.putStr [ " Inputs for block " , shortenTxHash blkHash, " are unique: " ] + if length tabs == length (List.nub tabs) + then Text.putStrLn $ green "ok" + else do + Text.putStrLn $ red "validateInputsUnique failed" + exitFailure + +-- https://github.com/input-output-hk/cardano-explorer/issues/195 +validateOutputsUnique :: Text -> [CTxBrief] -> IO () +validateOutputsUnique blkHash tabs = do + mapM_ Text.putStr [ " Outputs for block " , shortenTxHash blkHash, " are unique: " ] + if length tabs == length (List.nub tabs) + then Text.putStrLn $ green "ok" + else do + Text.putStrLn $ red "validateOutputsUnique failed" + exitFailure + + +-- ------------------------------------------------------------------------------------------------- + +shortenTxHash :: Text -> Text +shortenTxHash txh = + mconcat [Text.take 10 txh, "...", Text.drop (Text.length txh - 10) txh] diff --git a/cardano-explorer-webapi/app/Explorer/Web/Validate/Random.hs b/cardano-explorer-webapi/app/Explorer/Web/Validate/Random.hs index 087b2a0..c26067b 100644 --- a/cardano-explorer-webapi/app/Explorer/Web/Validate/Random.hs +++ b/cardano-explorer-webapi/app/Explorer/Web/Validate/Random.hs @@ -10,18 +10,17 @@ module Explorer.Web.Validate.Random import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans.Reader (ReaderT) +import Data.ByteString.Char8 (ByteString) import Data.Maybe (listToMaybe) import Data.Text (Text) import Database.Esqueleto (Entity (..), InnerJoin (..), Value (..), SqlExpr, - (^.), (==.), - countRows, from, on, select, val, where_) + (^.), (==.), (>.), + asc, countRows, from, offset, on, orderBy, select, val, where_) import Database.Persist.Sql (SqlBackend) import Explorer.DB (BlockId, EntityField (..), LookupFail (..), Key (..), - TxOut (..), TxOutId, isJust, maybeToEither) - -import Explorer.Web.Api.Legacy.Util (bsBase16Encode) + TxOut (..), TxOutId, maybeToEither) import System.Random (randomRIO) @@ -43,19 +42,24 @@ queryRandomAddress = do errMsg :: LookupFail errMsg = DbLookupMessage "queryRandomAddress: Lookup address by index failed" -queryRandomBlockHash :: MonadIO m => ReaderT SqlBackend m (Either LookupFail Text) +queryRandomBlockHash :: MonadIO m => ReaderT SqlBackend m (Either LookupFail ByteString) queryRandomBlockHash = do res <- select . from $ \ blk -> do - where_ (isJust (blk ^. BlockBlockNo)) + where_ (blk ^. BlockTxCount >. val 0) pure countRows case listToMaybe res of Nothing -> pure $ Left (DbLookupMessage "queryRandomBlockHash: Empty Block table") Just (Value blkCount) -> do blkid <- liftIO $ randomRIO (1, blkCount - 1) res1 <- select . from $ \ blk -> do - where_ (blk ^. BlockId ==. val (mkBlockId blkid)) + where_ (blk ^. BlockTxCount >. val 0) + if False + then do + orderBy [asc (blk ^. BlockId)] + offset blkid + else pure () pure (blk ^. BlockHash) - pure $ maybeToEither errMsg (bsBase16Encode . unValue) (listToMaybe res1) + pure $ maybeToEither errMsg unValue (listToMaybe res1) where errMsg :: LookupFail errMsg = DbLookupMessage "queryRandomBlockHash: Lookup block by index failed" diff --git a/cardano-explorer-webapi/cardano-explorer-webapi.cabal b/cardano-explorer-webapi/cardano-explorer-webapi.cabal index ecb82ba..a7a4364 100644 --- a/cardano-explorer-webapi/cardano-explorer-webapi.cabal +++ b/cardano-explorer-webapi/cardano-explorer-webapi.cabal @@ -175,6 +175,7 @@ executable cardano-webapi-validate other-modules: Explorer.Web.Validate Explorer.Web.Validate.Address + Explorer.Web.Validate.BlocksTxs Explorer.Web.Validate.ErrorHandling Explorer.Web.Validate.GenesisAddress Explorer.Web.Validate.Random diff --git a/cardano-explorer-webapi/src/Explorer/Web.hs b/cardano-explorer-webapi/src/Explorer/Web.hs index 90c3b6d..ec151ab 100644 --- a/cardano-explorer-webapi/src/Explorer/Web.hs +++ b/cardano-explorer-webapi/src/Explorer/Web.hs @@ -3,6 +3,7 @@ module Explorer.Web -- For testing. , CAddress (..) + , CTxAddressBrief (..) , CAddressSummary (..) , CCoin (..) , CGenesisAddressInfo (..) @@ -11,14 +12,16 @@ module Explorer.Web , CTxHash (..) , queryAddressSummary , queryAllGenesisAddresses + , queryBlocksTxs , queryChainTip , runQuery ) where import Explorer.Web.Api.Legacy.AddressSummary (queryAddressSummary) +import Explorer.Web.Api.Legacy.BlocksTxs (queryBlocksTxs) import Explorer.Web.Api.Legacy.GenesisAddress (queryAllGenesisAddresses) import Explorer.Web.Api.Legacy.Util (runQuery) -import Explorer.Web.ClientTypes (CAddress (..), CAddressSummary (..), CCoin (..), - CGenesisAddressInfo (..), CHash (..), CTxBrief (..), CTxHash (..)) +import Explorer.Web.ClientTypes (CAddress (..), CTxAddressBrief (..), CAddressSummary (..), + CCoin (..), CGenesisAddressInfo (..), CHash (..), CTxBrief (..), CTxHash (..)) import Explorer.Web.Query (queryChainTip) import Explorer.Web.Server (runServer) diff --git a/cardano-explorer-webapi/src/Explorer/Web/Api/Legacy/BlocksTxs.hs b/cardano-explorer-webapi/src/Explorer/Web/Api/Legacy/BlocksTxs.hs index 6dce195..b8201c2 100644 --- a/cardano-explorer-webapi/src/Explorer/Web/Api/Legacy/BlocksTxs.hs +++ b/cardano-explorer-webapi/src/Explorer/Web/Api/Legacy/BlocksTxs.hs @@ -3,6 +3,9 @@ module Explorer.Web.Api.Legacy.BlocksTxs ( blocksTxs + + -- For testing: + , queryBlocksTxs ) where import Control.Monad.IO.Class (MonadIO) @@ -11,22 +14,22 @@ import Control.Monad.Trans.Reader (ReaderT) import Data.ByteString.Char8 (ByteString) import Data.Int (Int64) +import Data.List.Extra (groupOn) import Data.Maybe (fromMaybe) import Data.Time.Clock (UTCTime) -import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) import Data.Text (Text) import Data.Word (Word16, Word64) import Database.Esqueleto (InnerJoin (..), Value (..), (^.), (==.), (&&.), - from, limit, in_, offset, on, select, val, valList, where_) + distinct, from, in_, on, select, val, valList, where_) import Database.Persist.Sql (SqlBackend) import Explorer.DB (EntityField (..), TxId, unValue3) -import Explorer.Web.Api.Legacy.Util (bsBase16Encode, genesisDistributionTxHash, - runQuery, textBase16Decode) -import Explorer.Web.ClientTypes (CAddress (..), CCoin (..), CHash (..), +import Explorer.Web.Api.Legacy.Util (bsBase16Encode, collapseTxGroup, + genesisDistributionTxHash, runQuery, textBase16Decode, zipTxBrief) +import Explorer.Web.ClientTypes (CAddress (..), CHash (..), CTxAddressBrief (..), CTxBrief (..), CTxHash (..), mkCCoin) import Explorer.Web.Error (ExplorerError (..)) @@ -38,7 +41,7 @@ import Servant (Handler) -- /api/blocks/txs/d30117e2e488cb3f496a47305eee3c8ea01e83e9e91e2719f1677de07f902e9a -- /api/blocks/txs/c25f5468195e95dc6e7acbc0f0da794113b0edbfe1f998e10c85e2a1ec679e83 -- /api/blocks/txs/e22e8771de60d44820c72b10114a7aee7cf98e3b188936e8601f9a12637edf63 - +-- /api/blocks/txs/619457f25781b1c32c935e711a019d8c584574b363b27f3ae1393bddb895017a blocksTxs :: SqlBackend -> CHash @@ -48,80 +51,81 @@ blocksTxs blocksTxs backend (CHash blkHashTxt) mLimit mOffset = case textBase16Decode blkHashTxt of Left err -> pure $ Left err - Right blkHash -> runQuery backend $ queryBlockByHash blkHash pageSize page + Right blkHash -> runQuery backend $ queryBlocksTxs blkHash pageSize page where pageSize = fromMaybe 10 mLimit page = fromMaybe 0 mOffset -queryBlockByHash :: MonadIO m => ByteString -> Int64 -> Int64 -> ReaderT SqlBackend m (Either ExplorerError [CTxBrief]) -queryBlockByHash blkHash limitNum offsetNum = do +queryBlocksTxs :: MonadIO m => ByteString -> Int64 -> Int64 -> ReaderT SqlBackend m (Either ExplorerError [CTxBrief]) +queryBlocksTxs blkHash _limitNum _offsetNum = do res <- select . from $ \ (blk `InnerJoin` tx) -> do on (blk ^. BlockId ==. tx ^. TxBlock) where_ (blk ^. BlockHash ==. val blkHash) - limit limitNum - offset offsetNum + -- limit limitNum + -- offset offsetNum pure (tx ^. TxId, tx ^. TxHash, blk ^. BlockTime) case map unValue3 res of [] -> pure $ Left (Internal "No block found") - -- TODO: This can still do with some improvement. - xs -> Right <$> mapM (queryCTxBrief (map fst3 xs)) xs + xs -> Right <$> queryCTxBriefs xs + +queryCTxBriefs :: MonadIO m => [(TxId, ByteString, UTCTime)] -> ReaderT SqlBackend m [CTxBrief] +queryCTxBriefs [] = pure [] +queryCTxBriefs xs = do + let txids = map fst3 xs + zipTxBrief xs <$> queryTxInputs txids <*> queryTxOutputs txids + +queryTxInputs :: MonadIO m => [TxId] -> ReaderT SqlBackend m [(TxId, [CTxAddressBrief])] +queryTxInputs txids = do + rows <- select . distinct . from $ \(tx `InnerJoin` txIn `InnerJoin` txOut `InnerJoin` txInTx) -> do + on (txInTx ^. TxId ==. txIn ^. TxInTxOutId) + on (txIn ^. TxInTxOutId ==. txOut ^. TxOutTxId + &&. txIn ^. TxInTxOutIndex ==. txOut ^. TxOutIndex) + on (tx ^. TxId ==. txIn ^. TxInTxInId) + where_ (txIn ^. TxInTxInId `in_` valList txids) + pure (tx ^. TxId, txOut ^. TxOutAddress, txOut ^. TxOutValue, txInTx ^. TxHash, txOut ^. TxOutIndex, txInTx ^. TxSize ==. val 0) + pure $ map collapseTxGroup (groupOn fst $ map convert rows) where - fst3 :: (a, b, c) -> a - fst3 (a, _, _) = a - -queryCTxBrief :: MonadIO m => [TxId] -> (TxId, ByteString, UTCTime) -> ReaderT SqlBackend m CTxBrief -queryCTxBrief txOutIds (txId, txhash, utctime) = do - inrows <- select . from $ \(tx `InnerJoin` txIn `InnerJoin` txOut `InnerJoin` txInTx) -> do - on (txInTx ^. TxId ==. txIn ^. TxInTxOutId) - on (txIn ^. TxInTxOutId ==. txOut ^. TxOutTxId - &&. txIn ^. TxInTxOutIndex ==. txOut ^. TxOutIndex) - on (tx ^. TxId ==. txIn ^. TxInTxOutId) - where_ (txIn ^. TxInTxInId ==. val txId) - -- A Tx with a size of zero is a transaction to create a Geneisis Distribution output. - pure (txOut ^. TxOutAddress, txOut ^. TxOutValue, txInTx ^. TxHash, txOut ^. TxOutIndex, tx ^. TxSize ==. val 0) - let inputs = map convertIn inrows - outrows <- select . from $ \(tx `InnerJoin` txOut) -> do - on (tx ^. TxId ==. txOut ^. TxOutTxId) - where_ (txOut ^. TxOutTxId `in_` valList txOutIds) - pure (txOut ^. TxOutAddress, txOut ^. TxOutValue, tx ^. TxHash, txOut ^. TxOutIndex) - let outputs = map convertOut outrows - inSum = sum $ map (unCCoin . ctaAmount) inputs - outSum = sum $ map (unCCoin . ctaAmount) outputs - pure $ CTxBrief - { ctbId = CTxHash $ CHash (bsBase16Encode txhash) - , ctbTimeIssued = Just $ utcTimeToPOSIXSeconds utctime - , ctbInputs = inputs - , ctbOutputs = outputs - , ctbInputSum = mkCCoin inSum - , ctbOutputSum = mkCCoin outSum - -- Only redeem address have zero input and zero fees. - , ctbFees = mkCCoin $ if inSum == 0 then 0 else inSum - outSum - } + convert :: (Value TxId, Value Text, Value Word64, Value ByteString, Value Word16, Value Bool) -> (TxId, CTxAddressBrief) + convert (Value txid, Value addr, Value coin, Value txh, Value index, Value isGenesisTx) = + ( txid + , if isGenesisTx + then + CTxAddressBrief + { ctaAddress = CAddress addr + , ctaAmount = mkCCoin $ fromIntegral coin + , ctaTxHash = if True then genesisDistributionTxHash else CTxHash (CHash "queryTxInputs Genesis") + , ctaTxIndex = 0 + } + else + CTxAddressBrief + { ctaAddress = CAddress addr + , ctaAmount = mkCCoin $ fromIntegral coin + , ctaTxHash = CTxHash $ CHash (bsBase16Encode txh) + , ctaTxIndex = fromIntegral index + } + ) + +queryTxOutputs :: MonadIO m => [TxId] -> ReaderT SqlBackend m [(TxId, [CTxAddressBrief])] +queryTxOutputs txids = do + rows <- select . from $ \ (tx `InnerJoin` txOut) -> do + on (tx ^. TxId ==. txOut ^. TxOutTxId) + where_ (tx ^. TxId `in_` valList txids) + pure (tx ^. TxId, txOut ^. TxOutAddress, txOut ^. TxOutValue, tx ^. TxHash, txOut ^. TxOutIndex) + pure $ map collapseTxGroup (groupOn fst $ map convert rows) where - convertIn :: (Value Text, Value Word64, Value ByteString, Value Word16, Value Bool) -> CTxAddressBrief - convertIn (Value addr, Value coin, Value txh, Value index, Value isGenesisTx) = - if isGenesisTx - then - CTxAddressBrief - { ctaAddress = CAddress addr - , ctaAmount = mkCCoin $ fromIntegral coin - , ctaTxHash = genesisDistributionTxHash - , ctaTxIndex = 0 - } - else - CTxAddressBrief - { ctaAddress = CAddress addr - , ctaAmount = mkCCoin $ fromIntegral coin - , ctaTxHash = CTxHash $ CHash (bsBase16Encode txh) - , ctaTxIndex = fromIntegral index - } - - convertOut :: (Value Text, Value Word64, Value ByteString, Value Word16) -> CTxAddressBrief - convertOut (Value addr, Value coin, Value txh, Value index) = - CTxAddressBrief - { ctaAddress = CAddress addr - , ctaAmount = mkCCoin $ fromIntegral coin - , ctaTxHash = CTxHash $ CHash (bsBase16Encode txh) - , ctaTxIndex = fromIntegral index - } + convert :: (Value TxId, Value Text, Value Word64, Value ByteString, Value Word16) -> (TxId, CTxAddressBrief) + convert (Value txid, Value addr, Value coin, Value txhash, Value index) = + ( txid + , CTxAddressBrief + { ctaAddress = CAddress addr + , ctaAmount = mkCCoin $ fromIntegral coin + , ctaTxHash = CTxHash . CHash $ bsBase16Encode txhash + , ctaTxIndex = fromIntegral index + } + ) + +-- ------------------------------------------------------------------------------------------------- + +fst3 :: (a, b, c) -> a +fst3 (a, _, _) = a diff --git a/cardano-explorer-webapi/src/Explorer/Web/ClientTypes.hs b/cardano-explorer-webapi/src/Explorer/Web/ClientTypes.hs index 7058e84..8bfe349 100644 --- a/cardano-explorer-webapi/src/Explorer/Web/ClientTypes.hs +++ b/cardano-explorer-webapi/src/Explorer/Web/ClientTypes.hs @@ -194,14 +194,14 @@ data CTxBrief = CTxBrief , ctbInputSum :: !CCoin , ctbOutputSum :: !CCoin , ctbFees :: !CCoin - } deriving (Show, Generic) + } deriving (Eq, Generic, Show) data CTxAddressBrief = CTxAddressBrief { ctaAddress :: !CAddress , ctaAmount :: !CCoin , ctaTxHash :: !CTxHash , ctaTxIndex :: !Word - } deriving (Show, Generic) + } deriving (Eq, Generic, Show) data CUtxo = CUtxo { cuId :: !CTxHash diff --git a/cardano-explorer/app/Explorer/Web/Validate.hs b/cardano-explorer/app/Explorer/Web/Validate.hs new file mode 100644 index 0000000..d778f76 --- /dev/null +++ b/cardano-explorer/app/Explorer/Web/Validate.hs @@ -0,0 +1,115 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Explorer.Web.Validate + ( runValidation + ) where + +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.Logger (runNoLoggingT) + +import Data.Text.ANSI (green, red) +import qualified Data.Text.IO as Text + +import Database.Persist.Postgresql (withPostgresqlConn) +import Database.Persist.Sql (SqlBackend) + +import Explorer.DB (LookupFail, readPGPassFileEnv, renderLookupFail, toConnectionString) + +import Explorer.Web (CAddress (..), CAddressSummary (..), CCoin (..), + queryAddressSummary, runQuery) +import Explorer.Web.Error (ExplorerError (..), renderExplorerError) +import Explorer.Web.Api.Legacy.Util (decodeTextAddress, textShow) +import Explorer.Web.Random (queryRandomAddress, queryRandomRedeemAddress) + +import System.Exit (exitFailure) + +runValidation :: Word -> IO () +runValidation count = do + pgconfig <- readPGPassFileEnv + runNoLoggingT . + withPostgresqlConn (toConnectionString pgconfig) $ \backend -> + liftIO $ loop backend count + where + loop :: SqlBackend -> Word -> IO () + loop backend n + | n == 0 = pure () + | otherwise = do + validate backend + loop backend (n - 1) + +validate :: SqlBackend -> IO () +validate backend = do + findWorst backend + if False + then validateRedeemAddressSummary backend + else pure () + validateAddressSummary backend + + +findWorst :: SqlBackend -> IO () +findWorst backend = do + addrSum <- runQuery backend $ do + let addrTxt = "DdzFFzCqrhssKt9voak6J9nQ85vP8PHecMNXtBQFsmzoWaLb9poUF85NCty5nfciRPDYBf6pPCctM9SmkAwu1RyFhDWeVhbrd5RdrNHt" + addr <- handleExplorerError $ decodeTextAddress addrTxt + handleExplorerError =<< queryAddressSummary addrTxt addr + reportAddressSummary addrSum + loop addrSum + where + loop :: CAddressSummary -> IO () + loop oldAddrSum = do + addrSum <- runQuery backend $ do + addrTxt <- handleLookupFail =<< queryRandomAddress + addr <- handleExplorerError $ decodeTextAddress addrTxt + handleExplorerError =<< queryAddressSummary addrTxt addr + let balance = unCCoin (caBalance addrSum) + if balance >= 0 + then loop oldAddrSum + else if caTxNum oldAddrSum < caTxNum addrSum + then loop oldAddrSum + else reportAddressSummary addrSum >> loop addrSum + +validateAddressSummary :: SqlBackend -> IO () +validateAddressSummary backend = do + addrSum <- runQuery backend $ do + addrTxt <- handleLookupFail =<< queryRandomAddress + addr <- handleExplorerError $ decodeTextAddress addrTxt + handleExplorerError =<< queryAddressSummary addrTxt addr + reportAddressSummary addrSum + +validateRedeemAddressSummary :: SqlBackend -> IO () +validateRedeemAddressSummary backend = do + addrSum <- runQuery backend $ do + addrTxt <- handleLookupFail =<< queryRandomRedeemAddress + addr <- handleExplorerError $ decodeTextAddress addrTxt + handleExplorerError =<< queryAddressSummary addrTxt addr + reportAddressSummary addrSum + +reportAddressSummary :: CAddressSummary -> IO () +reportAddressSummary addrSum = + mapM_ Text.putStrLn + [ "Address: " <> unCAddress (caAddress addrSum) + , " type: " <> textShow (caType addrSum) + , " tx count: " <> textShow (caTxNum addrSum) + , " balance: " <> + let balance = unCCoin (caBalance addrSum) in + if balance < 0 + then red (textShow balance) + else green (textShow balance) + , "" + ] + +handleLookupFail :: MonadIO m => Either LookupFail a -> m a +handleLookupFail ela = + case ela of + Left err -> liftIO $ do + Text.putStrLn $ renderLookupFail err + exitFailure + Right v -> pure v + +handleExplorerError :: MonadIO m => Either ExplorerError a -> m a +handleExplorerError eea = + case eea of + Left err -> liftIO $ do + Text.putStrLn $ renderExplorerError err + exitFailure + Right v -> pure v