WIP: Working scripts commit with mempty user utxo

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

@@ -57,7 +57,7 @@ import Hydra.Cluster.Fixture (Actor (..), actorName, alice, aliceSk, aliceVk, bo
 import Hydra.Cluster.Util (chainConfigFor, keysFor)
 import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod))
 import Hydra.Ledger (IsTx (balance))
-import Hydra.Ledger.Cardano (genKeyPair)
+import Hydra.Ledger.Cardano (addVkInputs, genKeyPair)
 import Hydra.Logging (Tracer, traceWith)
 import Hydra.Options (ChainConfig, networkId, startChainFrom)
 import Hydra.Party (Party)
@@ -252,25 +252,29 @@ singlePartyCommitsFromExternalScript tracer workDir node hydraScriptsTxId =
       send n1 $ input "Init" []
       headId <- waitMatch 600 n1 $ headIsInitializingWith (Set.fromList [alice])
 
-      let script = fromPlutusScript @PlutusScriptV2 $ Plutus.alwaysSucceedingNAryFunction 2
-          scriptAddress = mkScriptAddress @PlutusScriptV2 networkId script
-          reedemer = ()
-          datum = ()
-          scriptInfo = ScriptInfo (toScriptData reedemer) (toScriptData datum) script
-
+      let script1 = fromPlutusScript @PlutusScriptV2 $ Plutus.alwaysSucceedingNAryFunction 2
+          script2 = fromPlutusScript @PlutusScriptV2 $ Plutus.alwaysSucceedingNAryFunction 2
+          scriptAddress1 = mkScriptAddress @PlutusScriptV2 networkId script1
+          scriptAddress2 = mkScriptAddress @PlutusScriptV2 networkId script2
+          reedemer = 1 :: Integer
+          datum = 2 :: Integer
+          scriptInfo1 = ScriptInfo (toScriptData reedemer) (toScriptData datum) script1
+          scriptInfo2 = ScriptInfo (toScriptData reedemer) (toScriptData datum) script2
       (someVk, someSk) <- generate genKeyPair
       pparams <- queryProtocolParameters networkId nodeSocket QueryTip
 
       -- TODO: createScriptOutput spends from faucet directly
-      normalUTxO <- seedFromFaucet node someVk 10_000_000 Normal (contramap FromFaucet tracer)
-      scriptUtxo1 <- createScriptOutput pparams scriptAddress someSk normalUTxO datum
-      someUtxo2 <- seedFromFaucet node someVk 10_000_000 Normal (contramap FromFaucet tracer)
-      scriptUtxo2 <- createScriptOutput pparams scriptAddress someSk someUtxo2 datum
+      -- regularUtxo <- seedFromFaucet node someVk 10_000_000 Normal (contramap FromFaucet tracer)
+      normalUTxO1 <- seedFromFaucet node someVk 10_000_000 Normal (contramap FromFaucet tracer)
+      scriptUtxo1 <- createScriptOutput pparams scriptAddress1 someSk normalUTxO1 datum
+      normalUTxO2 <- seedFromFaucet node someVk 10_000_000 Normal (contramap FromFaucet tracer)
+      scriptUtxo2 <- createScriptOutput pparams scriptAddress2 someSk normalUTxO2 datum
+      let regularUtxo :: UTxO = mempty
       let scriptUtxos = scriptUtxo1 <> scriptUtxo2
-          scriptInfos = (\(txIn, txOut) -> (txIn, txOut, scriptInfo)) <$> UTxO.pairs scriptUtxos
+          scriptInfos = (\((txIn, txOut), scriptInfo) -> (txIn, txOut, scriptInfo)) <$> zip (UTxO.pairs scriptUtxos) [scriptInfo1, scriptInfo2]
 
       -- Request to build a draft commit tx from hydra-node
-      let clientPayload = DraftCommitTxRequest @Tx scriptUtxos scriptInfos
+      let clientPayload = DraftCommitTxRequest @Tx regularUtxo scriptInfos
       response <-
         runReq defaultHttpConfig $
           req
@@ -287,8 +291,8 @@ singlePartyCommitsFromExternalScript tracer workDir node hydraScriptsTxId =
       putTextLn . toText $ renderTxWithUTxO scriptUtxos commitTx
       submitTransaction networkId nodeSocket commitTx
 
-      waitFor tracer 600 [n1] $
-        output "HeadIsOpen" ["utxo" .= scriptUtxos, "headId" .= headId]
+      waitFor tracer 60 [n1] $
+        output "HeadIsOpen" ["utxo" .= regularUtxo, "headId" .= headId]
  where
   RunningNode{networkId, nodeSocket} = node
 

hydra-node/src/Hydra/API/Server.hs

@@ -362,12 +362,11 @@ handleDraftCommitUtxo directChain tracer body reqMethod reqPaths respond = do
           }
       let userUtxo = utxo requestInput
       eCommitTx <- case toCommit requestInput of
-        [] -> do
-          draftTx userUtxo
+        [] -> draftTx userUtxo
         scriptsToCommit -> do
           let infos =
-                ( \(txIn, _, ScriptInfo{redeemer, datum, plutusV2Script}) ->
-                    (txIn, ScriptDatumForTxIn datum, redeemer, plutusV2Script)
+                ( \(txIn, txOut, ScriptInfo{redeemer, datum, plutusV2Script}) ->
+                    (txIn, txOut, ScriptDatumForTxIn datum, redeemer, plutusV2Script)
                 )
                   <$> scriptsToCommit
           draftScriptTx userUtxo infos
@@ -380,7 +379,7 @@ handleDraftCommitUtxo directChain tracer body reqMethod reqPaths respond = do
               CannotCommitReferenceScript -> return400 e
               CommittedTooMuchADAForMainnet _ _ -> return400 e
               UnsupportedLegacyOutput _ -> return400 e
-              _ -> responseLBS status500 [] (Aeson.encode $ toJSON e)
+              _ -> traceShow e $ responseLBS status500 [] (Aeson.encode $ toJSON e)
           Right commitTx ->
             responseLBS status200 [] (Aeson.encode $ DraftCommitTxResponse commitTx)
  where

hydra-node/src/Hydra/Chain.hs

@@ -20,13 +20,15 @@ import Data.List (nub)
 import Hydra.Cardano.Api (
   Address,
   ByronAddr,
+  CtxUTxO,
   HasTypeProxy (..),
   Lovelace (..),
   PlutusScript,
   ScriptDatum,
   ScriptRedeemer,
   SerialiseAsRawBytes (..),
   TxIn,
+  TxOut,
   UsingRawBytesHex (..),
   WitCtxTxIn,
  )
@@ -197,9 +199,9 @@ data Chain tx m = Chain
   -- 'CommittedTooMuchADAForMainnet', 'UnsupportedLegacyOutput' and other
   -- possible exceptions are turned into 500 errors
   , draftScriptTx ::
-      (IsChainState tx, MonadThrow m) =>
+      (IsChainState tx, MonadThrow m, MonadIO m) =>
       UTxOType tx ->
-      [(TxIn, ScriptDatum WitCtxTxIn, ScriptRedeemer, PlutusScript)] ->
+      [(TxIn, TxOut CtxUTxO, ScriptDatum WitCtxTxIn, ScriptRedeemer, PlutusScript)] ->
       m (Either (PostTxError tx) tx)
   }
 

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

@@ -37,6 +37,7 @@ import Hydra.Cardano.Api (
   pattern ScriptWitness,
   pattern TxInsCollateral,
  )
+import Hydra.Cardano.Api.Pretty (renderTx, renderTxWithUTxO)
 import Hydra.Chain (
   Chain (..),
   ChainCallback,
@@ -173,11 +174,20 @@ mkChain tracer queryTimeHandle wallet ctx LocalChainState{getLatest} submitTx pp
           Initial st ->
             sequenceA $ finalizeTx wallet ctx chainState utxo <$> commit ctx st utxo
           _ -> pure $ Left FailedToDraftTxNotInitializing
-    , draftScriptTx = \scriptUtxo scriptInfos -> do
+    , draftScriptTx = \regularUtxo scriptInfos -> do
         chainState <- atomically getLatest
+        let utxos' = (\(a, b, _, _, _) -> (a, b)) <$> scriptInfos
+        let scriptUtxo = UTxO.fromPairs utxos'
+        let toScriptInput (txIn, _, datum, redeemer, script) =
+              ( txIn
+              , BuildTxWith $
+                  ScriptWitness ScriptWitnessForSpending $
+                    mkScriptWitness script datum redeemer
+              )
+        let scriptInputs = toScriptInput <$> scriptInfos
         case Hydra.Chain.Direct.State.chainState chainState of
           Initial st ->
-            case commitScript ctx st scriptUtxo of
+            case commitScript ctx st regularUtxo scriptInputs of
               Left CannotCommitReferenceScript -> pure $ Left CannotCommitReferenceScript
               Left (CommittedTooMuchADAForMainnet l ml) -> pure $ Left $ CommittedTooMuchADAForMainnet l ml
               Left e -> throwIO e
@@ -187,10 +197,10 @@ mkChain tracer queryTimeHandle wallet ctx LocalChainState{getLatest} submitTx pp
                     commitScriptTx =
                       unsafeBuildTransaction $
                         commitScriptTxBody
-                          & addTxIns scriptInfos
-                          & setTxInsCollateral (TxInsCollateral collateralTxIns)
-                          & setTxProtocolParams (BuildTxWith $ Just pparams)
-                Right <$> finalizeTx wallet ctx chainState scriptUtxo commitScriptTx
+                -- & addTxIns scriptInfos
+                -- & setTxInsCollateral (TxInsCollateral collateralTxIns)
+                -- & setTxProtocolParams (BuildTxWith $ Just pparams)
+                Right <$> finalizeTx wallet ctx chainState (regularUtxo <> scriptUtxo) commitScriptTx
            where
             addTxIns infos bodyTx =
               case infos of
@@ -199,7 +209,7 @@ mkChain tracer queryTimeHandle wallet ctx LocalChainState{getLatest} submitTx pp
                   addTxIns
                     rest
                     (bodyTx & addTxIn (toScriptInput info))
-            toScriptInput (txIn, datum, redeemer, script) =
+            toScriptInput (txIn, _, datum, redeemer, script) =
               ( txIn
               , BuildTxWith $
                   ScriptWitness ScriptWitnessForSpending $
@@ -232,7 +242,7 @@ finalizeTx TinyWallet{sign, coverFee} ctx ChainStateAt{chainState} userUTxO part
             } ::
             PostTxError Tx
         )
-    Left e ->
+    Left e -> do
       throwIO
         ( InternalWalletError
             { headUTxO

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

@@ -19,6 +19,7 @@ import Data.Maybe (fromJust)
 import Hydra.Cardano.Api (
   AssetName (AssetName),
   BuildTx,
+  BuildTxWith,
   ChainPoint (..),
   CtxUTxO,
   Hash,
@@ -37,6 +38,8 @@ import Hydra.Cardano.Api (
   UTxO,
   UTxO' (UTxO),
   Value,
+  WitCtxTxIn,
+  Witness,
   chainPointToSlotNo,
   genTxIn,
   modifyTxOutValue,
@@ -326,18 +329,19 @@ commitScript ::
   ChainContext ->
   InitialState ->
   UTxO ->
+  [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn))] ->
   Either
     (PostTxError Tx)
     (TxBodyContent BuildTx)
-commitScript ctx st utxo = do
+commitScript ctx st utxo scriptInputs = do
   case ownInitial ctx st of
     Nothing ->
       Left (CannotFindOwnInitial{knownUTxO = getKnownUTxO st})
     Just initial -> do
       rejectByronAddress utxo
       rejectReferenceScripts utxo
       rejectMoreThanMainnetLimit networkId utxo
-      Right $ rawCommitTxBody networkId scriptRegistry headId ownParty utxo initial
+      Right $ rawCommitTxBody networkId scriptRegistry headId ownParty utxo initial scriptInputs
  where
   ChainContext{networkId, ownParty, scriptRegistry} = ctx
   InitialState{headId} = st

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

@@ -178,7 +178,7 @@ commitTx ::
   Tx
 commitTx networkId scriptRegistry headId party utxo (initialInput, out, vkh) =
   unsafeBuildTransaction $
-    rawCommitTxBody networkId scriptRegistry headId party utxo (initialInput, out, vkh)
+    rawCommitTxBody networkId scriptRegistry headId party utxo (initialInput, out, vkh) []
 
 -- | Craft a commit transaction body which includes the "committed" utxo as a datum.
 rawCommitTxBody ::
@@ -192,15 +192,20 @@ rawCommitTxBody ::
   -- | The initial output (sent to each party) which should contain the PT and is
   -- locked by initial script
   (TxIn, TxOut ctx, Hash PaymentKey) ->
+  [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn))] ->
   TxBodyContent BuildTx
-rawCommitTxBody networkId scriptRegistry headId party utxo (initialInput, out, vkh) =
-  emptyTxBody
-    & addInputs [(initialInput, initialWitness)]
-    & addReferenceInputs [initialScriptRef]
-    & addVkInputs committedTxIns
-    & addExtraRequiredSigners [vkh]
-    & addOutputs [commitOutput]
+rawCommitTxBody networkId scriptRegistry headId party utxo (initialInput, out, vkh) scriptInputs =
+  traceShow "here" $
+    traceShow scriptInputs $
+      emptyTxBody
+        & addInputs ([(initialInput, initialWitness)] <> scriptInputs)
+        & addReferenceInputs [initialScriptRef]
+        & addVkInputs committedTxIns
+        & addExtraRequiredSigners [vkh]
+        & addOutputs [commitOutput]
  where
+  -- Filter out regular user utxo
+  -- utxo = UTxO.fromPairs $ filter (\(txIn, _) -> txIn `notElem` (fst <$> scriptInputs)) (UTxO.pairs utxo')
   initialWitness =
     BuildTxWith $
       ScriptWitness scriptWitnessInCtx $

hydra-node/test/Hydra/API/ServerSpec.hs

@@ -397,7 +397,7 @@ dummyChainHandle =
   Chain
     { postTx = \_ -> error "unexpected call to postTx"
     , draftTx = \_ -> error "unexpected call to draftTx"
-    , draftScriptTx = \_ _ _ _ -> error "unexpected call to draftScriptTx"
+    , draftScriptTx = \_ -> error "unexpected call to draftScriptTx"
     }
 
 noop :: Applicative m => a -> m ()

hydra-node/test/Hydra/BehaviorSpec.hs

@@ -598,7 +598,7 @@ simulatedChainAndNetwork initialChainState = do
                   Chain
                     { postTx = postTx nodes history chainStateVar
                     , draftTx = \_ -> error "unexpected call to draftTx"
-                    , draftScriptTx = \_ _ _ _ -> error "unexpected call to draftScriptTx"
+                    , draftScriptTx = \_ -> error "unexpected call to draftScriptTx"
                     }
               , hn = createMockNetwork node nodes
               }
@@ -765,7 +765,7 @@ createHydraNode ledger nodeState signingKey otherParties outputs outputHistory c
           Chain
             { postTx = \_ -> pure ()
             , draftTx = \_ -> error "draftTx not implemented"
-            , draftScriptTx = \_ _ _ _ -> error "draftTx not implemented"
+            , draftScriptTx = \_ -> error "draftTx not implemented"
             }
       , server =
           Server

hydra-node/test/Hydra/NodeSpec.hs

@@ -174,7 +174,7 @@ createHydraNode signingKey otherParties contestationPeriod events = do
           Chain
             { postTx = \_ -> pure ()
             , draftTx = \_ -> error "draftTx not implemented"
-            , draftScriptTx = \_ _ _ _ -> error "draftTx not implemented"
+            , draftScriptTx = \_ -> error "draftTx not implemented"
             }
       , server = Server{sendOutput = \_ -> pure ()}
       , ledger = simpleLedger
@@ -223,6 +223,6 @@ throwExceptionOnPostTx exception node =
           Chain
             { postTx = \_ -> throwIO exception
             , draftTx = \_ -> error "draftTx not implemented"
-            , draftScriptTx = \_ _ _ _ -> error "draftTx not implemented"
+            , draftScriptTx = \_ -> error "draftTx not implemented"
             }
       }