WIP: Improve schnorkel test cases

Still getting PPViewHashesDontMatch but this is the final error to solve

hydra-cluster/hydra-cluster.cabal

@@ -88,7 +88,6 @@ library
     , base                  >=4.7 && <5
     , bytestring
     , cardano-slotting
-    , cardano-api
     , containers
     , contra-tracer
     , data-default
@@ -99,7 +98,6 @@ library
     , hydra-cardano-api
     , hydra-node
     , hydra-prelude
-    , hydra-plutus
     , hydra-test-utils
     , hydra-tx
     , hydra-tx:testlib
@@ -108,8 +106,6 @@ library
     , lens
     , lens-aeson
     , optparse-applicative
-    , plutus-ledger-api
-    , plutus-tx
     , process
     , QuickCheck
     , req

hydra-cluster/src/Hydra/Cluster/Scenarios.hs

@@ -6,20 +6,17 @@ module Hydra.Cluster.Scenarios where
 import Hydra.Prelude
 import Test.Hydra.Prelude
 
-import qualified Cardano.Api.Shelley        as C
-import qualified PlutusTx.Prelude           as PlutusTx
-import qualified PlutusLedgerApi.V1         as PV1
 import Cardano.Api.UTxO qualified as UTxO
 import CardanoClient (
   QueryPoint (QueryTip),
   RunningNode (..),
   buildTransaction,
+  queryProtocolParameters,
   queryTip,
   queryUTxOFor,
   submitTx,
   waitForUTxO,
  )
-import Hydra.Contract.Dummy (dummyValidatorHash)
 import CardanoNode (NodeLog)
 import Control.Concurrent.Async (mapConcurrently_)
 import Control.Lens ((^..), (^?))
@@ -41,12 +38,9 @@ import Hydra.Cardano.Api (
   Coin (..),
   File (File),
   Key (SigningKey),
+  KeyWitnessInCtx (KeyWitnessForSpending),
   PaymentKey,
-  StakeAddressReference(..),
-  PaymentCredential(..),
   Tx,
-  shelleyBasedEra,
-  makeShelleyAddressInEra,
   TxId,
   UTxO,
   getTxBody,
@@ -57,19 +51,23 @@ import Hydra.Cardano.Api (
   mkScriptAddress,
   mkScriptDatum,
   mkScriptWitness,
+  mkTxOutAutoBalance,
   mkTxOutDatumHash,
   mkVkAddress,
   scriptWitnessInCtx,
   selectLovelace,
+  setTxFee,
   signTx,
   toScriptData,
   txOutValue,
   utxoFromTx,
   writeFileTextEnvelope,
   pattern BuildTxWith,
+  pattern KeyWitness,
   pattern PlutusScriptSerialised,
   pattern ReferenceScriptNone,
   pattern ScriptWitness,
+  pattern TxFeeExplicit,
   pattern TxOut,
   pattern TxOutDatumNone,
  )
@@ -79,7 +77,7 @@ import Hydra.Cluster.Fixture (Actor (..), actorName, alice, aliceSk, aliceVk, bo
 import Hydra.Cluster.Mithril (MithrilLog)
 import Hydra.Cluster.Options (Options)
 import Hydra.Cluster.Util (chainConfigFor, keysFor, modifyConfig, setNetworkId)
-import Hydra.Ledger.Cardano (addInputs, emptyTxBody, mkSimpleTx, mkTransferTx, unsafeBuildTransaction)
+import Hydra.Ledger.Cardano (addCollateralInput, addInputs, addOutputs, emptyTxBody, mkSimpleTx, mkTransferTx, unsafeBuildTransaction)
 import Hydra.Logging (Tracer, traceWith)
 import Hydra.Options (DirectChainConfig (..), networkId, startChainFrom)
 import Hydra.Tx (HeadId, IsTx (balance), Party, txId)
@@ -100,6 +98,7 @@ import HydraNode (
   waitMatch,
   withHydraCluster,
   withHydraNode,
+  withHydraNodeRealFee,
  )
 import Network.HTTP.Conduit (parseUrlThrow)
 import Network.HTTP.Conduit qualified as L
@@ -402,32 +401,96 @@ singlePartyUsesSchnorrkelScriptOnL2 tracer workDir node hydraScriptsTxId =
     let hydraTracer = contramap FromHydraNode tracer
     (walletVk, walletSk) <- keysFor AliceFunds
     utxoToCommit <- seedFromFaucet node walletVk 5_000_000 (contramap FromFaucet tracer)
-    withHydraNode hydraTracer aliceChainConfig workDir hydraNodeId aliceSk [] [1] $ \n1 -> do
+    withHydraNodeRealFee hydraTracer aliceChainConfig workDir hydraNodeId aliceSk [] [1] $ \n1 -> do
       send n1 $ input "Init" []
       headId <- waitMatch (10 * blockTime) n1 $ headIsInitializingWith (Set.fromList [alice])
+
       requestCommitTx n1 utxoToCommit <&> signTx walletSk >>= submitTx node
       waitFor hydraTracer (10 * blockTime) [n1] $
         output "HeadIsOpen" ["utxo" .= toJSON utxoToCommit, "headId" .= headId]
-      scriptHash <- unTransScriptHash dummyValidatorHash
-      let scriptAddress = makeShelleyAddressInEra shelleyBasedEra networkId (PaymentCredentialByScript scriptHash) NoStakeAddress
-      let i = undefined
-      let o = undefined
-      let tx = mkSimpleTx (i, o) (scriptAddress, txOutValue o) walletSk
-      send n1 $ input "NewTx" ["transaction" .= tx]
+      (clientPayload, scriptUTxO) <- prepareScriptPayload
+      res <-
+        runReq defaultHttpConfig $
+          req
+            POST
+            (http "127.0.0.1" /: "commit")
+            (ReqBodyJson clientPayload)
+            (Proxy :: Proxy (JsonResponse Tx))
+            (port $ 4000 + hydraNodeId)
+
+      let commitTx = responseBody res
+      submitTx node commitTx
+
+      depositTxId <- waitMatch (10 * blockTime) n1 $ \v -> do
+        guard $ v ^? key "headId" == Just (toJSON headId)
+        guard $ v ^? key "tag" == Just "CommitFinalized"
+        pure $ v ^? key "theDeposit"
+      depositTxId `shouldBe` Just (toJSON $ getTxId $ getTxBody commitTx)
+      let (collateralInput, _) = List.head $ UTxO.pairs utxoToCommit
+
+      let (scriptInput, _) = List.head $ UTxO.pairs scriptUTxO
+      let (normalInput', _) = List.head $ UTxO.pairs utxoToCommit
+      pparams <- queryProtocolParameters networkId nodeSocket QueryTip
+      writeFileLBS "queried-from-code-pparams.json" (Aeson.encode pparams)
+
+      let serializedScript = PlutusScriptSerialised dummyValidatorScript
+      let scriptAddress = mkScriptAddress networkId serializedScript
+      let scriptOutput =
+            mkTxOutAutoBalance
+              pparams
+              scriptAddress
+              (lovelaceToValue 0)
+              (mkTxOutDatumHash ())
+              ReferenceScriptNone
+      let returnOutput =
+            TxOut (mkVkAddress networkId walletVk) (lovelaceToValue 4_826_535) TxOutDatumNone ReferenceScriptNone
+      let normalInput = (,BuildTxWith $ KeyWitness KeyWitnessForSpending) <$> [normalInput']
+      let scriptWitness =
+            BuildTxWith $
+              ScriptWitness scriptWitnessInCtx $
+                mkScriptWitness serializedScript (mkScriptDatum ()) (toScriptData ())
+      let tx =
+            unsafeBuildTransaction $
+              emptyTxBody
+                & addInputs ([(spy' "script input" scriptInput, scriptWitness)] <> spy' "normal input" normalInput)
+                & addCollateralInput collateralInput
+                & addOutputs [spy' "script output" scriptOutput, spy' "return output" returnOutput]
+                & setTxFee (TxFeeExplicit $ Coin 173_465)
+      let signedL2tx = signTx walletSk tx
+      send n1 $ input "NewTx" ["transaction" .= signedL2tx]
+
       waitMatch 10 n1 $ \v -> do
         guard $ v ^? key "tag" == Just "SnapshotConfirmed"
         guard $
           toJSON tx
             `elem` (v ^.. key "snapshot" . key "confirmed" . values)
         v ^? key "snapshot" . key "utxo" >>= parseMaybe parseJSON
-  where
-    RunningNode{networkId, nodeSocket, blockTime} = node
-    unTransScriptHash :: PV1.ScriptHash -> IO C.ScriptHash
-    unTransScriptHash (PV1.ScriptHash vh) =
-      case C.deserialiseFromRawBytes C.AsScriptHash $ PlutusTx.fromBuiltin vh of
-        Left e -> fail $ show e
-        Right x -> pure x
+ where
+  RunningNode{networkId, nodeSocket, blockTime} = node
+  -- TODO: extract this to standalone function
+  prepareScriptPayload = do
+    let script = dummyValidatorScript
+    let serializedScript = PlutusScriptSerialised script
+    let scriptAddress = mkScriptAddress networkId serializedScript
+    let datumHash = mkTxOutDatumHash ()
+    (scriptIn, scriptOut) <- createOutputAtAddress node scriptAddress datumHash (lovelaceToValue 0)
+    let scriptUTxO = UTxO.singleton (scriptIn, scriptOut)
 
+    let scriptWitness =
+          BuildTxWith $
+            ScriptWitness scriptWitnessInCtx $
+              mkScriptWitness serializedScript (mkScriptDatum ()) (toScriptData ())
+    let spendingTx =
+          unsafeBuildTransaction $
+            emptyTxBody
+              & addInputs [(scriptIn, scriptWitness)]
+    pure
+      ( Aeson.object
+          [ "blueprintTx" .= spendingTx
+          , "utxo" .= scriptUTxO
+          ]
+      , scriptUTxO
+      )
 
 singlePartyCommitsScriptBlueprint ::
   Tracer IO EndToEndLog ->

hydra-cluster/src/HydraNode.hs

@@ -310,7 +310,7 @@ withHydraNode ::
   IO a
 withHydraNode tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds action = do
   withLogFile logFilePath $ \logFileHandle -> do
-    withHydraNode' tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds (Just logFileHandle) $ do
+    withHydraNode' tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds (Just logFileHandle) True $ do
       \_ err processHandle -> do
         race
           (checkProcessHasNotDied ("hydra-node (" <> show hydraNodeId <> ")") processHandle (Just err))
@@ -319,6 +319,31 @@ withHydraNode tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNod
  where
   logFilePath = workDir </> "logs" </> "hydra-node-" <> show hydraNodeId <.> "log"
 
+-- | Run a hydra-node with given 'ChainConfig', and real protocol parameters (no zero fees).
+withHydraNodeRealFee ::
+  Tracer IO HydraNodeLog ->
+  ChainConfig ->
+  FilePath ->
+  Int ->
+  SigningKey HydraKey ->
+  [VerificationKey HydraKey] ->
+  [Int] ->
+  (HydraClient -> IO a) ->
+  IO a
+withHydraNodeRealFee tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds action = do
+  withLogFile logFilePath $ \logFileHandle -> do
+    withHydraNode' tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds (Just logFileHandle) False $ do
+      \_ err processHandle -> do
+        race
+          (checkProcessHasNotDied ("hydra-node (" <> show hydraNodeId <> ")") processHandle (Just err))
+          (withConnectionToNode tracer hydraNodeId action)
+          <&> either absurd id
+ where
+  logFilePath = workDir </> "logs" </> "hydra-node-" <> show hydraNodeId <.> "log"
+
+-- | A bit of boolean blindness, if this type is True we should zero the fees in queried protocol parameters.
+type ZeroFees = Bool
+
 -- | Run a hydra-node with given 'ChainConfig' and using the config from
 -- config/.
 withHydraNode' ::
@@ -331,9 +356,10 @@ withHydraNode' ::
   [Int] ->
   -- | If given use this as std out.
   Maybe Handle ->
+  ZeroFees ->
   (Handle -> Handle -> ProcessHandle -> IO a) ->
   IO a
-withHydraNode' tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds mGivenStdOut action = do
+withHydraNode' tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds mGivenStdOut zeroFees action = do
   -- NOTE: AirPlay on MacOS uses 5000 and we must avoid it.
   when (os == "darwin") $ port `shouldNotBe` (5_000 :: Network.PortNumber)
   withSystemTempDirectory "hydra-node" $ \dir -> do
@@ -345,12 +371,18 @@ withHydraNode' tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNo
       Direct DirectChainConfig{nodeSocket, networkId} -> do
         -- NOTE: This implicitly tests of cardano-cli with hydra-node
         protocolParameters <- cliQueryProtocolParameters nodeSocket networkId
+        print cardanoLedgerProtocolParametersFile
         Aeson.encodeFile cardanoLedgerProtocolParametersFile $
-          protocolParameters
-            & atKey "txFeeFixed" ?~ toJSON (Number 0)
-            & atKey "txFeePerByte" ?~ toJSON (Number 0)
-            & key "executionUnitPrices" . atKey "priceMemory" ?~ toJSON (Number 0)
-            & key "executionUnitPrices" . atKey "priceSteps" ?~ toJSON (Number 0)
+          if zeroFees
+            then
+              protocolParameters
+                & atKey "txFeeFixed" ?~ toJSON (Number 0)
+                & atKey "txFeePerByte" ?~ toJSON (Number 0)
+                & key "executionUnitPrices" . atKey "priceMemory" ?~ toJSON (Number 0)
+                & key "executionUnitPrices" . atKey "priceSteps" ?~ toJSON (Number 0)
+            else
+              protocolParameters
+        writeFileLBS "queried-pparams.json" (Aeson.encode protocolParameters)
 
     let hydraSigningKey = dir </> (show hydraNodeId <> ".sk")
     void $ writeFileTextEnvelope (File hydraSigningKey) Nothing hydraSKey
@@ -384,14 +416,14 @@ withHydraNode' tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNo
                 }
           )
             { std_out = maybe CreatePipe UseHandle mGivenStdOut
-            , std_err = CreatePipe
+            , std_err = Inherit
             }
 
     traceWith tracer $ HydraNodeCommandSpec $ show $ cmdspec p
 
     withCreateProcess p $ \_stdin mCreatedStdOut mCreatedStdErr processHandle ->
       case (mCreatedStdOut <|> mGivenStdOut, mCreatedStdErr) of
-        (Just out, Just err) -> action out err processHandle
+        (Just out, Nothing) -> action out stderr processHandle
         (Nothing, _) -> error "Should not happen™"
         (_, Nothing) -> error "Should not happen™"
  where

hydra-cluster/test/Test/EndToEndSpec.hs

@@ -520,7 +520,7 @@ spec = around (showLogsOnFailure "EndToEndSpec") $ do
             let hydraTracer = contramap FromHydraNode tracer
             hydraScriptsTxId <- publishHydraScriptsAs node Faucet
             chainConfig <- chainConfigFor Alice dir nodeSocket hydraScriptsTxId [] (UnsafeContestationPeriod 1)
-            withHydraNode' hydraTracer chainConfig dir 1 aliceSk [] [1] Nothing $ \stdOut _ _processHandle -> do
+            withHydraNode' hydraTracer chainConfig dir 1 aliceSk [] [1] Nothing False $ \stdOut _ _processHandle -> do
               waitForLog 10 stdOut "JSON object with key NodeOptions" $ \line ->
                 line ^? key "message" . key "tag" == Just (Aeson.String "NodeOptions")
 

hydra-node/src/Hydra/Chain/Direct/Wallet.hs

@@ -71,6 +71,7 @@ import Cardano.Slotting.EpochInfo (EpochInfo)
 import Cardano.Slotting.Time (SystemStart (..))
 import Control.Concurrent.Class.MonadSTM (check, newTVarIO, readTVarIO, writeTVar)
 import Control.Lens (view, (%~), (.~), (^.))
+import Data.Aeson qualified as Aeson
 import Data.List qualified as List
 import Data.Map.Strict ((!))
 import Data.Map.Strict qualified as Map
@@ -179,6 +180,7 @@ newTinyWallet tracer networkId (vk, sk) queryWalletInfo queryEpochInfo querySome
           -- We query pparams here again as it's possible that a hardfork
           -- occurred and the pparams changed.
           pparams <- querySomePParams
+          writeFileLBS "pparams.json" (Aeson.encode pparams)
           pure $
             fromLedgerTx
               <$> coverFee_ pparams systemStart epochInfo ledgerLookupUTxO walletUTxO (toLedgerTx partialTx)

hydra-tx/src/Hydra/Ledger/Cardano/Builder.hs

@@ -83,6 +83,11 @@ addInputs :: TxIns BuildTx -> TxBodyContent BuildTx -> TxBodyContent BuildTx
 addInputs ins tx =
   tx{txIns = txIns tx <> ins}
 
+-- | Add new inputs to an ongoing builder.
+addCollateralInput :: TxIn -> TxBodyContent BuildTx -> TxBodyContent BuildTx
+addCollateralInput txin tx =
+  tx{txInsCollateral = TxInsCollateral [txin]}
+
 addReferenceInputs :: [TxIn] -> TxBodyContent BuildTx -> TxBodyContent BuildTx
 addReferenceInputs refs' tx =
   tx