Externally commit script utxo

docs/package.json

@@ -10,9 +10,7 @@
     "start": "yarn dummy-spec && docusaurus start",
     "validate:inputs": "./validate-api.js publish '/' '../hydra-node/golden/ReasonablySized (ClientInput (Tx BabbageEra)).json'",
     "validate:outputs": "./validate-api.js subscribe '/' '../hydra-node/golden/ReasonablySized (TimedServerOutput (Tx BabbageEra)).json'",
-    "validate:commit-inputs": "./validate-api.js publish '/commit' '../hydra-node/golden/ReasonablySized (DraftCommitTxRequest (Tx BabbageEra)).json'",
-    "validate:commit-outputs": "./validate-api.js subscribe '/commit' '../hydra-node/golden/ReasonablySized (DraftCommitTxResponse (Tx BabbageEra)).json'",
-    "validate": "yarn validate:inputs && yarn validate:outputs && yarn validate:commit-inputs && yarn validate:commit-outputs",
+    "validate": "yarn validate:inputs && yarn validate:outputs",
     "swizzle": "docusaurus swizzle",
     "deploy": "docusaurus deploy",
     "clear": "docusaurus clear",

hydra-cardano-api/src/Cardano/Api/UTxO.hs

@@ -36,6 +36,8 @@ newtype UTxO' out = UTxO
     , Foldable
     , Semigroup
     , Monoid
+    , ToJSON
+    , FromJSON
     )
 
 instance Traversable UTxO' where
@@ -46,7 +48,7 @@ fromPairs :: [(TxIn, out)] -> UTxO' out
 fromPairs = UTxO . Map.fromList
 
 -- | Create a 'UTxO' from a single unspent transaction output.
-singleton :: (TxIn, TxOut CtxUTxO Era) -> UTxO
+singleton :: (TxIn, out) -> UTxO' out
 singleton (i, o) = UTxO $ Map.singleton i o
 
 -- | Find an 'out' for a given 'TxIn'.

hydra-cardano-api/src/Hydra/Cardano/Api/PlutusScript.hs

@@ -6,7 +6,9 @@ import Hydra.Cardano.Api.Prelude
 
 import qualified Cardano.Ledger.Alonzo.Language as Ledger
 import qualified Cardano.Ledger.Alonzo.Scripts as Ledger
+import qualified Data.ByteString.Short as SBS
 import qualified PlutusLedgerApi.Common as Plutus
+import Test.QuickCheck (listOf)
 
 -- * Type Conversions
 
@@ -49,3 +51,7 @@ instance IsPlutusScriptLanguage lang => FromJSON (PlutusScript lang) where
     case deserialiseFromTextEnvelope (proxyToAsType Proxy) env of
       Left e -> fail $ show e
       Right a -> pure a
+
+instance Arbitrary (PlutusScript lang) where
+  arbitrary =
+    PlutusScriptSerialised . SBS.pack <$> listOf arbitrary

hydra-cardano-api/src/Hydra/Cardano/Api/ScriptData.hs

@@ -9,10 +9,12 @@ import qualified Cardano.Ledger.Alonzo.Data as Ledger
 import qualified Cardano.Ledger.Alonzo.TxWitness as Ledger
 import Codec.Serialise (deserialiseOrFail, serialise)
 import Control.Arrow (left)
-import Data.Aeson (Value (String))
+import Data.Aeson (Value (String), withText)
+import qualified Data.ByteString as BS
 import qualified Data.ByteString.Base16 as Base16
 import qualified Data.Map as Map
 import qualified PlutusLedgerApi.V2 as Plutus
+import Test.QuickCheck (arbitrarySizedNatural, choose, oneof, scale, sized, vector)
 
 -- * Extras
 
@@ -96,13 +98,30 @@ instance FromJSON ScriptData where
       bytes <- Base16.decode (encodeUtf8 text)
       left show $ deserialiseOrFail $ fromStrict bytes
 
--- NOTE: We are okay with storing the data and re-serializing + hashing it into
--- 'HashableScriptData' in these ToJSON/FromJSON instances as the serialization
--- ambiguity addressed by 'HashableScriptData' is long overboard if we are
--- dealing with JSON.
+instance Arbitrary ScriptData where
+  arbitrary =
+    scale (`div` 2) $
+      oneof
+        [ ScriptDataConstructor <$> arbitrarySizedNatural <*> arbitrary
+        , ScriptDataNumber <$> arbitrary
+        , ScriptDataBytes <$> arbitraryBS
+        , ScriptDataList <$> arbitrary
+        , ScriptDataMap <$> arbitrary
+        ]
+   where
+    arbitraryBS = sized $ \n ->
+      BS.pack <$> (choose (0, min n 64) >>= vector)
 
 instance ToJSON HashableScriptData where
-  toJSON = toJSON . getScriptData
+  toJSON = String . decodeUtf8 . Base16.encode . serialiseToCBOR
 
 instance FromJSON HashableScriptData where
-  parseJSON = fmap unsafeHashableScriptData . parseJSON
+  parseJSON =
+    withText "HashableScriptData" $ \text -> do
+      bytes <- either (fail . show) pure $ Base16.decode $ encodeUtf8 text
+      either (fail . show) pure $ deserialiseFromCBOR (proxyToAsType Proxy) bytes
+
+instance Arbitrary HashableScriptData where
+  arbitrary =
+    -- NOTE: Safe to use here as the data was not available in serialized form.
+    unsafeHashableScriptData <$> arbitrary

hydra-cluster/hydra-cluster.cabal

@@ -133,6 +133,7 @@ library
     , directory
     , filepath
     , hspec-expectations
+    , http-client
     , hydra-cardano-api
     , hydra-node
     , hydra-plutus
@@ -159,6 +160,7 @@ library
     , unix
     , unordered-containers
     , websockets
+    , plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib}  >=1.1.1.0
 
   ghc-options:     -haddock
 
@@ -238,7 +240,7 @@ test-suite tests
     , lens
     , lens-aeson
     , ouroboros-network
-    , plutus-ledger-api
+    , plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib}  >=1.1.1.0
     , process
     , QuickCheck
     , say

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

@@ -6,6 +6,7 @@ module Hydra.Cluster.Faucet where
 
 import Hydra.Cardano.Api
 import Hydra.Prelude
+import Test.Hydra.Prelude
 
 import qualified Cardano.Api.UTxO as UTxO
 import CardanoClient (
@@ -24,7 +25,7 @@ import CardanoNode (RunningNode (..))
 import Control.Exception (IOException)
 import Control.Monad.Class.MonadThrow (Handler (Handler), catches)
 import Control.Tracer (Tracer, traceWith)
-import qualified Data.Map as Map
+import qualified Data.Map.Strict as Map
 import GHC.IO.Exception (IOErrorType (ResourceExhausted), IOException (ioe_type))
 import Hydra.Chain.Direct.ScriptRegistry (
   publishHydraScripts,
@@ -62,27 +63,19 @@ seedFromFaucet ::
   Marked ->
   Tracer IO FaucetLog ->
   IO UTxO
-seedFromFaucet RunningNode{networkId, nodeSocket} receivingVerificationKey lovelace marked tracer = do
+seedFromFaucet node@RunningNode{networkId, nodeSocket} receivingVerificationKey lovelace marked tracer = do
   (faucetVk, faucetSk) <- keysFor Faucet
   retryOnExceptions tracer $ submitSeedTx faucetVk faucetSk
   waitForPayment networkId nodeSocket lovelace receivingAddress
  where
   submitSeedTx faucetVk faucetSk = do
-    faucetUTxO <- findUTxO faucetVk
+    faucetUTxO <- findFaucetUTxO node lovelace
     let changeAddress = ShelleyAddressInEra (buildAddress faucetVk networkId)
     buildTransaction networkId nodeSocket changeAddress faucetUTxO [] [theOutput] >>= \case
       Left e -> throwIO $ FaucetFailedToBuildTx{reason = e}
       Right body -> do
         submitTransaction networkId nodeSocket (sign faucetSk body)
 
-  findUTxO faucetVk = do
-    faucetUTxO <- queryUTxO networkId nodeSocket QueryTip [buildAddress faucetVk networkId]
-    let foundUTxO = UTxO.filter (\o -> txOutLovelace o >= lovelace) faucetUTxO
-    when (null foundUTxO) $
-      throwIO $
-        FaucetHasNotEnoughFunds{faucetUTxO}
-    pure foundUTxO
-
   receivingAddress = buildAddress receivingVerificationKey networkId
 
   theOutput =
@@ -96,6 +89,16 @@ seedFromFaucet RunningNode{networkId, nodeSocket} receivingVerificationKey lovel
     Fuel -> TxOutDatumHash markerDatumHash
     Normal -> TxOutDatumNone
 
+findFaucetUTxO :: RunningNode -> Lovelace -> IO UTxO
+findFaucetUTxO RunningNode{networkId, nodeSocket} lovelace = do
+  (faucetVk, _) <- keysFor Faucet
+  faucetUTxO <- queryUTxO networkId nodeSocket QueryTip [buildAddress faucetVk networkId]
+  let foundUTxO = UTxO.filter (\o -> txOutLovelace o >= lovelace) faucetUTxO
+  when (null foundUTxO) $
+    throwIO $
+      FaucetHasNotEnoughFunds{faucetUTxO}
+  pure foundUTxO
+
 -- | Like 'seedFromFaucet', but without returning the seeded 'UTxO'.
 seedFromFaucet_ ::
   RunningNode ->
@@ -140,6 +143,49 @@ returnFundsToFaucet tracer node@RunningNode{networkId, nodeSocket} sender = do
           Left e -> throwIO $ FaucetFailedToBuildTx{reason = e}
           Right body -> pure body
 
+-- Use the Faucet utxo to create the output at specified address
+createOutputAtAddress ::
+  ToScriptData a =>
+  RunningNode ->
+  ProtocolParameters ->
+  AddressInEra ->
+  a ->
+  IO (TxIn, TxOut CtxUTxO)
+createOutputAtAddress node@RunningNode{networkId, nodeSocket} pparams atAddress datum = do
+  (faucetVk, faucetSk) <- keysFor Faucet
+  -- we don't care which faucet utxo we use here so just pass lovelace 0 to grab
+  -- any present utxo
+  utxo <- findFaucetUTxO node 0
+  buildTransaction
+    networkId
+    nodeSocket
+    (changeAddress faucetVk)
+    utxo
+    collateralTxIns
+    [output]
+    >>= \case
+      Left e ->
+        throwErrorAsException e
+      Right body -> do
+        let tx = makeSignedTransaction [makeShelleyKeyWitness body (WitnessPaymentKey faucetSk)] body
+        submitTransaction networkId nodeSocket tx
+        newUtxo <- awaitTransaction networkId nodeSocket tx
+        case UTxO.find (\out -> txOutAddress out == atAddress) newUtxo of
+          Nothing -> failure $ "Could not find script output: " <> decodeUtf8 (encodePretty newUtxo)
+          Just u -> pure u
+ where
+  collateralTxIns = mempty
+
+  changeAddress vk = mkVkAddress networkId vk
+
+  output =
+    mkTxOutAutoBalance
+      pparams
+      atAddress
+      mempty
+      (mkTxOutDatumHash datum)
+      ReferenceScriptNone
+
 -- | Build and sign tx and return the calculated fee.
 -- - Signing key should be the key of a sender
 -- - Address is used as a change address.