This repository has been archived by the owner on Apr 6, 2020. It is now read-only.
/
BlocksTxs.hs
59 lines (45 loc) · 2.16 KB
/
BlocksTxs.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
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]