[test] remove dependency on MT

input-output-hk · Jan 17, 2022 · 852cafe · 852cafe
1 parent 5103431
commit 852cafe
Showing 1 changed file with 43 additions and 54 deletions.
diff --git a/hydra-node/exe/tx-cost/Main.hs b/hydra-node/exe/tx-cost/Main.hs
@@ -11,9 +11,7 @@ import qualified Cardano.Ledger.Alonzo.TxBody as Ledger.Alonzo
 import qualified Cardano.Ledger.Shelley.API as Ledger
 import qualified Cardano.Ledger.Val as Ledger
 import Control.Exception (ErrorCall)
-import qualified Data.ByteString as BS
 import qualified Data.Map as Map
-import Data.Maybe (fromJust)
 import Data.Maybe.Strict (StrictMaybe (..))
 import Hydra.Chain.Direct.Tx (fanoutTx, plutusScript, policyId, scriptAddr)
 import qualified Hydra.Contract.Hash as Hash
@@ -48,23 +46,14 @@ import Hydra.Ledger.Cardano (
   unsafeBuildTransaction,
  )
 import Hydra.Ledger.Cardano.Evaluate (evaluateTx, pparams)
-import Plutus.MerkleTree (rootHash)
-import qualified Plutus.MerkleTree as MT
-import Plutus.MerkleTreeValidator (merkleTreeValidator, mtBuilderValidator)
 import Plutus.Orphans ()
 import Plutus.V1.Ledger.Api (toBuiltin, toData)
-import qualified PlutusTx.Builtins as Plutus
-import Test.Plutus.Validator (
-  ExUnits (ExUnits),
-  defaultMaxExecutionUnits,
-  evaluateScriptExecutionUnits,
- )
 import Test.QuickCheck (generate, vectorOf)
 
 main :: IO ()
 main = do
   costOfFanOut
-  costOfMerkleTree
+  --  costOfMerkleTree
   costOfHashing
 
 costOfFanOut :: IO ()
@@ -116,52 +105,52 @@ mkHeadOutput headDatum =
   headValue = Ledger.inject (Ledger.Coin 2_000_000)
   headDatumHash = Ledger.hashData @LedgerEra <$> headDatum
 
-costOfMerkleTree :: IO ()
-costOfMerkleTree = do
-  putStrLn "Cost of on-chain Merkle-Tree"
-  forM_ ([1 .. 10] <> [20, 30 .. 100] <> [120, 140 .. 500]) $ \numElems -> do
-    utxo <- fmap Plutus.toBuiltin <$> genFakeUtxos numElems
+-- costOfMerkleTree :: IO ()
+-- costOfMerkleTree = do
+--   putStrLn "Cost of on-chain Merkle-Tree"
+--   forM_ ([1 .. 10] <> [20, 30 .. 100] <> [120, 140 .. 500]) $ \numElems -> do
+--     utxo <- fmap Plutus.toBuiltin <$> genFakeUtxos numElems
 
-    let (memberMem, memberCpu) = executionCostForMember utxo
-        ExUnits (fromIntegral @_ @Double -> maxMem) (fromIntegral @_ @Double -> maxCpu) =
-          defaultMaxExecutionUnits
-        (builderMem, builderCpu) = executionCostForBuilder utxo
+--     let (memberMem, memberCpu) = executionCostForMember utxo
+--         ExUnits (fromIntegral @_ @Double -> maxMem) (fromIntegral @_ @Double -> maxCpu) =
+--           defaultMaxExecutionUnits
+--         (builderMem, builderCpu) = executionCostForBuilder utxo
 
-    putText $
-      show numElems
-        <> "\t"
-        <> show (100 * fromIntegral (fromIntegral memberMem `div` numElems) / maxMem)
-        <> "\t"
-        <> show (100 * fromIntegral (fromIntegral memberCpu `div` numElems) / maxCpu)
-    putTextLn
-      ( "\t"
-          <> show (100 * fromIntegral builderMem / maxMem)
-          <> "\t"
-          <> show (100 * fromIntegral builderCpu / maxCpu)
-      )
-      `catch` \(_ :: ErrorCall) ->
-        -- NOTE builder validator is likely to fail and thus raise an exception at low values
-        -- of numElems, so we put 0 instead
-        putTextLn "\t0\t0"
- where
-  -- NOTE: assume size of a UTXO is around  60 bytes
-  genFakeUtxos numElems = generate (vectorOf numElems $ BS.pack <$> vectorOf 60 arbitrary)
+--     putText $
+--       show numElems
+--         <> "\t"
+--         <> show (100 * fromIntegral (fromIntegral memberMem `div` numElems) / maxMem)
+--         <> "\t"
+--         <> show (100 * fromIntegral (fromIntegral memberCpu `div` numElems) / maxCpu)
+--     putTextLn
+--       ( "\t"
+--           <> show (100 * fromIntegral builderMem / maxMem)
+--           <> "\t"
+--           <> show (100 * fromIntegral builderCpu / maxCpu)
+--       )
+--       `catch` \(_ :: ErrorCall) ->
+--         -- NOTE builder validator is likely to fail and thus raise an exception at low values
+--         -- of numElems, so we put 0 instead
+--         putTextLn "\t0\t0"
+--  where
+--   -- NOTE: assume size of a UTXO is around  60 bytes
+--   genFakeUtxos numElems = generate (vectorOf numElems $ BS.pack <$> vectorOf 60 arbitrary)
 
-executionCostForMember :: [Plutus.BuiltinByteString] -> (Natural, Natural)
-executionCostForMember utxo =
-  let tree = MT.fromList utxo
-      accumulateCost e (curMem, curCpu) =
-        let proof = fromJust $ MT.mkProof e tree
-            ExUnits mem cpu = evaluateScriptExecutionUnits merkleTreeValidator (e, MT.rootHash tree, proof)
-         in (mem + curMem, cpu + curCpu)
-   in foldr accumulateCost (0, 0) utxo
+-- executionCostForMember :: [Plutus.BuiltinByteString] -> (Natural, Natural)
+-- executionCostForMember utxo =
+--   let tree = MT.fromList utxo
+--       accumulateCost e (curMem, curCpu) =
+--         let proof = fromJust $ MT.mkProof e tree
+--             ExUnits mem cpu = evaluateScriptExecutionUnits merkleTreeValidator (e, MT.rootHash tree, proof)
+--          in (mem + curMem, cpu + curCpu)
+--    in foldr accumulateCost (0, 0) utxo
 
-executionCostForBuilder :: [Plutus.BuiltinByteString] -> (Natural, Natural)
-executionCostForBuilder utxo =
-  let tree = MT.fromList utxo
-      root = rootHash tree
-      ExUnits mem cpu = evaluateScriptExecutionUnits mtBuilderValidator (utxo, root)
-   in (mem, cpu)
+-- executionCostForBuilder :: [Plutus.BuiltinByteString] -> (Natural, Natural)
+-- executionCostForBuilder utxo =
+--   let tree = MT.fromList utxo
+--       root = rootHash tree
+--       ExUnits mem cpu = evaluateScriptExecutionUnits mtBuilderValidator (utxo, root)
+--    in (mem, cpu)
 
 costOfHashing :: IO ()
 costOfHashing = do