Merge pull request #223 from input-output-hk/erikd/gh-195

webap: Fix /api/blocks/txs/{blkHash} endpoint

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 ""

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]

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"

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

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)

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