Dump decommit observation code

hydra-chain-observer/src/Hydra/ChainObserver.hs

@@ -51,6 +51,7 @@ import Ouroboros.Network.Protocol.ChainSync.Client (
   ClientStIntersect (..),
   ClientStNext (..),
  )
+import Hydra.Chain.Direct.Tx (DecrementObservation(..))
 
 main :: IO ()
 main = do
@@ -74,6 +75,7 @@ data ChainObserverLog
   | HeadInitTx {headId :: HeadId}
   | HeadCommitTx {headId :: HeadId}
   | HeadCollectComTx {headId :: HeadId}
+  | HeadDecrementTx {headId :: HeadId}
   | HeadCloseTx {headId :: HeadId}
   | HeadFanoutTx {headId :: HeadId}
   | HeadAbortTx {headId :: HeadId}
@@ -170,6 +172,7 @@ observeTx networkId utxo tx =
         Init InitObservation{headId} -> (utxo', pure $ HeadInitTx{headId})
         Commit CommitObservation{headId} -> (utxo', pure $ HeadCommitTx{headId})
         CollectCom CollectComObservation{headId} -> (utxo', pure $ HeadCollectComTx{headId})
+        Decrement DecrementObservation{headId} -> (utxo', pure $ HeadDecrementTx{headId})
         Close CloseObservation{headId} -> (utxo', pure $ HeadCloseTx{headId})
         Fanout FanoutObservation{headId} -> (utxo', pure $ HeadFanoutTx{headId})
         Abort AbortObservation{headId} -> (utxo', pure $ HeadAbortTx{headId})

hydra-chain-observer/test/Hydra/ChainObserverSpec.hs

@@ -24,6 +24,7 @@ spec =
                     Just (HeadInitTx{}) -> transition === Transition.Init
                     Just (HeadCommitTx{}) -> transition === Transition.Commit
                     Just (HeadCollectComTx{}) -> transition === Transition.Collect
+                    Just (HeadDecrementTx{}) -> transition === Transition.Decrement
                     Just (HeadAbortTx{}) -> transition === Transition.Abort
                     Just (HeadCloseTx{}) -> transition === Transition.Close
                     Just (HeadContestTx{}) -> transition === Transition.Contest

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

@@ -629,7 +629,7 @@ initWithWrongKeys workDir tracer node@RunningNode{nodeSocket} hydraScriptsTxId =
 canDecommit :: Tracer IO EndToEndLog -> FilePath -> RunningNode -> TxId -> IO ()
 canDecommit tracer workDir node hydraScriptsTxId =
   (`finally` returnFundsToFaucet tracer node Alice) $ do
-    refuelIfNeeded tracer node Alice 25_000_000
+    refuelIfNeeded tracer node Alice 55_000_000
     -- Start hydra-node on chain tip
     tip <- queryTip networkId nodeSocket
     let contestationPeriod = UnsafeContestationPeriod 100
@@ -652,26 +652,29 @@ canDecommit tracer workDir node hydraScriptsTxId =
 
       waitFor hydraTracer 10 [n1] $
         output "HeadIsOpen" ["utxo" .= commitUTxO, "headId" .= headId]
-
+      let walletAddress = mkVkAddress networkId walletVk
       decommitTx <-
         either (failure . show) pure $
           mkSimpleTx
             (List.head $ UTxO.pairs commitUTxO)
-            (mkVkAddress networkId walletVk, lovelaceToValue 2_000_000)
+            (walletAddress, lovelaceToValue 2_000_000)
             walletSk
 
       send n1 $ input "Decommit" ["decommitTx" .= decommitTx]
-      -- NOTE: Alternative:
+      -- NOTE: We should also test the alternative way of decommitting using
+      -- http endpoint:
       --   parseUrlThrow ("POST http://localhost:" <> show (4000 + hydraNodeId) <> "/decommit")
       --     <&> setRequestBodyJSON decommitTx
       --     >>= httpLbs
       let decommitUTxO = utxoFromTx decommitTx
       waitFor hydraTracer 10 [n1] $
         output "DecommitRequested" ["headId" .= headId, "utxoToDecommit" .= decommitUTxO]
       waitFor hydraTracer 10 [n1] $
-        output "DecommitApproved" []
+        output "DecommitApproved" ["headId" .= headId, "utxoToDecommit" .= decommitUTxO]
+      waitFor hydraTracer 10 [n1] $
+        output "DecommitFinalized" ["headId" .= headId]
 
-      failAfter 10 $ waitForUTxO node decommitUTxO
+      failAfter 20 $ waitForUTxO node decommitUTxO
  where
   hydraTracer = contramap FromHydraNode tracer
 

hydra-cluster/test/Test/ChainObserverSpec.hs

@@ -9,6 +9,7 @@ module Test.ChainObserverSpec where
 import Hydra.Prelude
 import Test.Hydra.Prelude
 
+import Cardano.Api.UTxO qualified as UTxO
 import CardanoClient (RunningNode (..), submitTx)
 import CardanoNode (NodeLog, withCardanoNodeDevnet)
 import Control.Concurrent.Class.MonadSTM (modifyTVar', newTVarIO, readTVarIO)
@@ -17,15 +18,18 @@ import Control.Lens ((^?))
 import Data.Aeson as Aeson
 import Data.Aeson.Lens (key, _String)
 import Data.ByteString (hGetLine)
+import Data.List qualified as List
 import Data.Text qualified as T
-import Hydra.Cardano.Api (NetworkId (..), NetworkMagic (..), unFile)
-import Hydra.Cluster.Faucet (FaucetLog, publishHydraScriptsAs, seedFromFaucet_)
+import Hydra.Cardano.Api (NetworkId (..), NetworkMagic (..), lovelaceToValue, mkVkAddress, unFile, utxoFromTx)
+import Hydra.Cluster.Faucet (FaucetLog, publishHydraScriptsAs, seedFromFaucet, seedFromFaucet_)
 import Hydra.Cluster.Fixture (Actor (..), aliceSk, cperiod)
 import Hydra.Cluster.Util (chainConfigFor, keysFor)
+import Hydra.Ledger.Cardano (genKeyPair, mkSimpleTx)
 import Hydra.Logging (showLogsOnFailure)
 import HydraNode (HydraNodeLog, input, output, requestCommitTx, send, waitFor, waitMatch, withHydraNode)
 import System.IO.Error (isEOFError, isIllegalOperation)
 import System.Process (CreateProcess (std_out), StdStream (..), proc, withCreateProcess)
+import Test.QuickCheck (generate)
 
 spec :: Spec
 spec = do
@@ -34,16 +38,20 @@ spec = do
       showLogsOnFailure "ChainObserverSpec" $ \tracer -> do
         withTempDir "hydra-chain-observer" $ \tmpDir -> do
           -- Start a cardano devnet
-          withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \cardanoNode@RunningNode{nodeSocket} -> do
+          withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \cardanoNode@RunningNode{networkId, nodeSocket} -> do
             -- Prepare a hydra-node
             let hydraTracer = contramap FromHydraNode tracer
             hydraScriptsTxId <- publishHydraScriptsAs cardanoNode Faucet
-            (aliceCardanoVk, _aliceCardanoSk) <- keysFor Alice
+            (aliceCardanoVk, aliceCardanoSk) <- keysFor Alice
             aliceChainConfig <- chainConfigFor Alice tmpDir nodeSocket hydraScriptsTxId [] cperiod
             withHydraNode hydraTracer aliceChainConfig tmpDir 1 aliceSk [] [1] $ \hydraNode -> do
               withChainObserver cardanoNode $ \observer -> do
                 seedFromFaucet_ cardanoNode aliceCardanoVk 100_000_000 (contramap FromFaucet tracer)
 
+                (walletVk, _walletSk) <- generate genKeyPair
+
+                commitUTxO <- seedFromFaucet cardanoNode aliceCardanoVk 10_000_000 (contramap FromFaucet tracer)
+
                 send hydraNode $ input "Init" []
 
                 headId <- waitMatch 5 hydraNode $ \v -> do
@@ -52,13 +60,29 @@ spec = do
 
                 chainObserverSees observer "HeadInitTx" headId
 
-                requestCommitTx hydraNode mempty >>= submitTx cardanoNode
+                commitTx <- requestCommitTx hydraNode commitUTxO
+
+                submitTx cardanoNode commitTx
+
                 waitFor hydraTracer 5 [hydraNode] $
                   output "HeadIsOpen" ["utxo" .= object mempty, "headId" .= headId]
 
                 chainObserverSees observer "HeadCommitTx" headId
                 chainObserverSees observer "HeadCollectComTx" headId
 
+                let walletAddress = mkVkAddress networkId walletVk
+
+                decommitTx <-
+                  either (failure . show) pure $
+                    mkSimpleTx
+                      (List.head $ UTxO.pairs $ utxoFromTx commitTx)
+                      (walletAddress, lovelaceToValue 2_000_000)
+                      aliceCardanoSk
+
+                send hydraNode $ input "Decommit" ["decommitTx" .= decommitTx]
+
+                chainObserverSees observer "HeadDecrementTx" headId
+
                 send hydraNode $ input "Close" []
 
                 chainObserverSees observer "HeadCloseTx" headId