Cleanup incremental decommit - Part 1

docs/core-concepts/index.md

@@ -10,44 +10,3 @@ import {useDocsSidebar} from '@docusaurus/theme-common/internal';
 
 <DocCardList items={useDocsSidebar().items.filter(({ docId }) => docId != "index")}/>
 ```
-
-### Incremental Decommits
-
-```mermaid
-sequenceDiagram
-    Alice->>HeadLogic: Decommit (decTx)
-    HeadLogic->>HeadLogic: canApply decTx
-
-    par broadcast
-        HeadLogic->>HeadLogic: ReqDec decTx
-    and
-        HeadLogic->>Node B: ReqDec decTx
-    end
-
-    HeadLogic -->> Alice: DecommitRequested
-
-    par Alice isLeader
-        HeadLogic->>HeadLogic: ReqSn decTx
-    and
-        HeadLogic->>Node B: ReqSn decTx
-    end
-
-    HeadLogic->>HeadLogic: canApply decTx, decUTxO =  outputs(decTx)
-    HeadLogic->>HeadLogic: sig = sign snapshot incl. decUTxO
-
-    par broadcast
-        HeadLogic->>HeadLogic: AckSn sig
-    and
-        HeadLogic->>Node B: AckSn sig
-    end
-
-    Node B->>HeadLogic: AckSn sig
-
-    HeadLogic -->> Alice: SnapshotConfirmed
-    HeadLogic -->> Alice: DecommitApproved
-
-    HeadLogic ->> Chain: DecrementTx snapshot sig
-    Chain ->> HeadLogic: OnDecrementTx
-    HeadLogic -->> Alice: DecommitFinalized
-```
-

docs/docs/dev/protocol.md

@@ -0,0 +1,43 @@
+# Protocol
+
+Additional implementation-specific documentation for the Hydra Head protocol and extensions like incremental decommits.
+
+### Incremental Decommits
+
+```mermaid
+sequenceDiagram
+    Alice->>HeadLogic: Decommit (decTx)
+    HeadLogic->>HeadLogic: canApply decTx
+
+    par broadcast
+        HeadLogic->>HeadLogic: ReqDec decTx
+    and
+        HeadLogic->>Node B: ReqDec decTx
+    end
+
+    HeadLogic -->> Alice: DecommitRequested
+
+    par Alice isLeader
+        HeadLogic->>HeadLogic: ReqSn decTx
+    and
+        HeadLogic->>Node B: ReqSn decTx
+    end
+
+    HeadLogic->>HeadLogic: canApply decTx, decUTxO =  outputs(decTx)
+    HeadLogic->>HeadLogic: sig = sign snapshot incl. decUTxO
+
+    par broadcast
+        HeadLogic->>HeadLogic: AckSn sig
+    and
+        HeadLogic->>Node B: AckSn sig
+    end
+
+    Node B->>HeadLogic: AckSn sig
+
+    HeadLogic -->> Alice: SnapshotConfirmed
+    HeadLogic -->> Alice: DecommitApproved
+
+    HeadLogic ->> Chain: DecrementTx snapshot sig
+    Chain ->> HeadLogic: OnDecrementTx
+    HeadLogic -->> Alice: DecommitFinalized
+```

docs/sidebars.js

@@ -83,6 +83,7 @@ module.exports = {
       type: "autogenerated",
       dirName: "dev",
     },
+    "dev/protocol",
     {
       type: "link",
       href: "/adr",

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

@@ -77,6 +77,7 @@ import HydraNode (
   getSnapshotUTxO,
   input,
   output,
+  postDecommit,
   requestCommitTx,
   send,
   waitFor,
@@ -103,7 +104,7 @@ import Network.HTTP.Req (
 import Network.HTTP.Simple (httpLbs, setRequestBodyJSON)
 import System.Directory (removeDirectoryRecursive)
 import System.FilePath ((</>))
-import Test.QuickCheck (choose, generate, oneof)
+import Test.QuickCheck (choose, elements, generate)
 
 data EndToEndLog
   = ClusterOptions {options :: Options}
@@ -610,7 +611,7 @@ canDecommit tracer workDir node hydraScriptsTxId =
         <&> \case
           Direct cfg -> Direct cfg{networkId, startChainFrom = Just tip}
           _ -> error "Should not be in offline mode"
-    withHydraNode hydraTracer aliceChainConfig workDir 1 aliceSk [] [1] $ \n1@HydraClient{hydraNodeId} -> do
+    withHydraNode hydraTracer aliceChainConfig workDir 1 aliceSk [] [1] $ \n1 -> do
       -- Initialize & open head
       send n1 $ input "Init" []
       headId <- waitMatch 10 n1 $ headIsInitializingWith (Set.fromList [alice])
@@ -648,20 +649,14 @@ canDecommit tracer workDir node hydraScriptsTxId =
           buildTransaction networkId nodeSocket aliceAddress commitUTxO2 (fst <$> UTxO.pairs commitUTxO2) decommitOutput >>= \case
             Left e -> failure $ show e
             Right body2 -> do
-              let callDecommitHttpEndpoint tx =
-                    void $
-                      L.parseUrlThrow ("POST http://127.0.0.1:" <> show (4000 + hydraNodeId) <> "/decommit")
-                        <&> setRequestBodyJSON tx
-                          >>= httpLbs
-
               -- Send unsigned decommit tx and expect failure
-              expectFailureOnUnsignedDecommitTx n1 headId body1 callDecommitHttpEndpoint
+              expectFailureOnUnsignedDecommitTx n1 headId body1
 
               -- Sign and re-send the decommit tx
-              expectSuccessOnSignedDecommitTx n1 headId walletSk body1 callDecommitHttpEndpoint
+              expectSuccessOnSignedDecommitTx n1 headId walletSk body1
 
               -- Decommit the second utxo
-              expectSuccessOnSignedDecommitTx n1 headId walletSk body2 callDecommitHttpEndpoint
+              expectSuccessOnSignedDecommitTx n1 headId walletSk body2
 
               -- Close and Fanout put whatever is left in the Head back to L1
               closeAndFanout headId n1 headUTxO (headAmount + (2 * decommitAmount)) walletVk
@@ -689,29 +684,36 @@ canDecommit tracer workDir node hydraScriptsTxId =
     let walletBalance = sum $ selectLovelace . txOutValue . snd <$> UTxO.pairs walletUTxO
     walletBalance `shouldBe` expectedFinalBalance
 
-  expectSuccessOnSignedDecommitTx n headId sk body httpCall = do
+  expectSuccessOnSignedDecommitTx n headId sk body = do
     let signedDecommitTx = makeSignedTransaction [makeShelleyKeyWitness body (WitnessPaymentKey sk)] body
-    let signedDecommitClientInput = send n $ input "Decommit" ["decommitTx" .= signedDecommitTx]
-    join . generate $ oneof [pure signedDecommitClientInput, pure $ httpCall signedDecommitTx]
+    join . generate $
+      elements
+        [ send n $ input "Decommit" ["decommitTx" .= signedDecommitTx]
+        , postDecommit n signedDecommitTx
+        ]
     let decommitUTxO = utxoFromTx signedDecommitTx
+        decommitTxId = txId signedDecommitTx
 
     waitFor hydraTracer 10 [n] $
-      output "DecommitRequested" ["headId" .= headId, "utxoToDecommit" .= decommitUTxO]
+      output "DecommitRequested" ["headId" .= headId, "decommitTx" .= signedDecommitTx, "utxoToDecommit" .= decommitUTxO]
     waitFor hydraTracer 10 [n] $
-      output "DecommitApproved" ["headId" .= headId, "utxoToDecommit" .= decommitUTxO]
+      output "DecommitApproved" ["headId" .= headId, "decommitTxId" .= decommitTxId, "utxoToDecommit" .= decommitUTxO]
     failAfter 10 $ waitForUTxO node decommitUTxO
     waitFor hydraTracer 10 [n] $
-      output "DecommitFinalized" ["headId" .= headId]
+      output "DecommitFinalized" ["headId" .= headId, "decommitTxId" .= decommitTxId]
 
-  expectFailureOnUnsignedDecommitTx n headId body httpCall = do
+  expectFailureOnUnsignedDecommitTx n headId body = do
     let unsignedDecommitTx = makeSignedTransaction [] body
-    let unsignedDecommitClientInput = send n $ input "Decommit" ["decommitTx" .= unsignedDecommitTx]
-    join . generate $ oneof [pure unsignedDecommitClientInput, pure $ httpCall unsignedDecommitTx]
+    join . generate $
+      elements
+        [ send n $ input "Decommit" ["decommitTx" .= unsignedDecommitTx]
+        , postDecommit n unsignedDecommitTx
+        ]
 
     validationError <- waitMatch 10 n $ \v -> do
       guard $ v ^? key "headId" == Just (toJSON headId)
       guard $ v ^? key "tag" == Just (Aeson.String "DecommitInvalid")
-      guard $ v ^? key "decommitInvalidReason" . key "decommitTx" == Just (toJSON unsignedDecommitTx)
+      guard $ v ^? key "decommitTx" == Just (toJSON unsignedDecommitTx)
       v ^? key "decommitInvalidReason" . key "validationError" . key "reason" . _JSON
 
     validationError `shouldContain` "MissingVKeyWitnessesUTXOW"
@@ -775,6 +777,7 @@ canCloseWithPendingDecommit tracer workDir node hydraScriptsTxId =
 
           -- Send signed decommit tx
           submitSignedDecommitTx n1 headId walletSk body callDecommitHttpEndpoint
+          threadDelay 2 -- FIXME: this test is actually the same as above, especially as we need to wait here to not fail submission
           -- Close and Fanout put whatever is left in the Head back to L1
           closeAndFanout headId n1 (headAmount + decommitAmount) walletVk
  where
@@ -802,14 +805,17 @@ canCloseWithPendingDecommit tracer workDir node hydraScriptsTxId =
 
   submitSignedDecommitTx n headId sk body httpCall = do
     let signedDecommitTx = makeSignedTransaction [makeShelleyKeyWitness body (WitnessPaymentKey sk)] body
-    let signedDecommitClientInput = send n $ input "Decommit" ["decommitTx" .= signedDecommitTx]
-    join . generate $ oneof [pure signedDecommitClientInput, pure $ httpCall signedDecommitTx]
+    join . generate $
+      elements
+        [ send n $ input "Decommit" ["decommitTx" .= signedDecommitTx]
+        , httpCall signedDecommitTx
+        ]
     let decommitUTxO = utxoFromTx signedDecommitTx
 
     waitFor hydraTracer 10 [n] $
-      output "DecommitRequested" ["headId" .= headId, "utxoToDecommit" .= decommitUTxO]
+      output "DecommitRequested" ["headId" .= headId, "decommitTx" .= signedDecommitTx, "utxoToDecommit" .= decommitUTxO]
     waitFor hydraTracer 10 [n] $
-      output "DecommitApproved" ["headId" .= headId, "utxoToDecommit" .= decommitUTxO]
+      output "DecommitApproved" ["headId" .= headId, "decommitTxId" .= txId signedDecommitTx, "utxoToDecommit" .= decommitUTxO]
 
   hydraTracer = contramap FromHydraNode tracer
 
@@ -836,7 +842,7 @@ canFanoutWithDecommitRecorded tracer workDir node hydraScriptsTxId =
           Direct cfg -> Direct cfg{networkId, startChainFrom = Just tip}
           _ -> error "Should not be in offline mode"
 
-    withHydraNode hydraTracer aliceChainConfig workDir 1 aliceSk [bobVk] [1, 2] $ \n1@HydraClient{hydraNodeId} ->
+    withHydraNode hydraTracer aliceChainConfig workDir 1 aliceSk [bobVk] [1, 2] $ \n1 ->
       withHydraNode hydraTracer bobChainConfig workDir 2 bobSk [aliceVk] [1, 2] $ \n2 -> do
         -- Initialize & open head
         send n1 $ input "Init" []
@@ -864,15 +870,13 @@ canFanoutWithDecommitRecorded tracer workDir node hydraScriptsTxId =
         buildTransaction networkId nodeSocket aliceWalletAddress commitUTxO (fst <$> UTxO.pairs commitUTxO) decommitOutput >>= \case
           Left e -> failure $ show e
           Right body -> do
-            let callDecommitHttpEndpoint tx =
-                  void $
-                    L.parseUrlThrow ("POST http://127.0.0.1:" <> show (4000 + hydraNodeId) <> "/decommit")
-                      <&> setRequestBodyJSON tx
-                        >>= httpLbs
             let signedDecommitTx = makeSignedTransaction [makeShelleyKeyWitness body (WitnessPaymentKey aliceWalletSk)] body
-            let signedDecommitClientInput = send n1 $ input "Decommit" ["decommitTx" .= signedDecommitTx]
 
-            join . generate $ oneof [pure signedDecommitClientInput, pure $ callDecommitHttpEndpoint signedDecommitTx]
+            join . generate $
+              elements
+                [ send n1 $ input "Decommit" ["decommitTx" .= signedDecommitTx]
+                , postDecommit n1 signedDecommitTx
+                ]
 
             let decommitUTxO = utxoFromTx signedDecommitTx
             waitForAllMatch (10 * blockTime) [n1] $ \v -> do

hydra-cluster/src/HydraNode.hs

@@ -28,8 +28,10 @@ import Hydra.Logging (Tracer, Verbosity (..), traceWith)
 import Hydra.Network (Host (Host), NodeId (NodeId))
 import Hydra.Network qualified as Network
 import Hydra.Options (ChainConfig (..), DirectChainConfig (..), LedgerConfig (..), RunOptions (..), defaultDirectChainConfig, toArgs)
+import Network.HTTP.Conduit (parseUrlThrow)
 import Network.HTTP.Req (GET (..), HttpException, JsonResponse, NoReqBody (..), POST (..), ReqBodyJson (..), defaultHttpConfig, responseBody, runReq, (/:))
 import Network.HTTP.Req qualified as Req
+import Network.HTTP.Simple (httpLbs, setRequestBodyJSON)
 import Network.WebSockets (Connection, ConnectionException, HandshakeException, receiveData, runClient, sendClose, sendTextData)
 import System.FilePath ((<.>), (</>))
 import System.IO.Temp (withSystemTempDirectory)
@@ -181,6 +183,14 @@ requestCommitTx HydraClient{hydraNodeId} utxos =
       (Proxy :: Proxy (JsonResponse (DraftCommitTxResponse Tx)))
       (Req.port $ 4_000 + hydraNodeId)
 
+-- | Submit a decommit transaction to the hydra-node.
+postDecommit :: HydraClient -> Tx -> IO ()
+postDecommit HydraClient{hydraNodeId} decommitTx = do
+  void $
+    parseUrlThrow ("POST http://127.0.0.1:" <> show (4000 + hydraNodeId) <> "/decommit")
+      <&> setRequestBodyJSON decommitTx
+        >>= httpLbs
+
 -- | Get the latest snapshot UTxO from the hydra-node. NOTE: While we usually
 -- avoid parsing responses using the same data types as the system under test,
 -- this parses the response as a 'UTxO' type as we often need to pick it apart.

hydra-cluster/test/Test/ChainObserverSpec.hs

@@ -23,6 +23,7 @@ import Hydra.Cardano.Api (NetworkId (..), NetworkMagic (..), lovelaceToValue, mk
 import Hydra.Cluster.Faucet (FaucetLog, publishHydraScriptsAs, seedFromFaucet, seedFromFaucet_)
 import Hydra.Cluster.Fixture (Actor (..), aliceSk, cperiod)
 import Hydra.Cluster.Util (chainConfigFor, keysFor)
+import Hydra.Ledger (txId)
 import Hydra.Ledger.Cardano (genKeyPair, mkSimpleTx)
 import Hydra.Logging (showLogsOnFailure)
 import HydraNode (HydraNodeLog, input, output, requestCommitTx, send, waitFor, waitMatch, withHydraNode)
@@ -83,7 +84,7 @@ spec = do
                 chainObserverSees observer "HeadDecrementTx" headId
 
                 waitFor hydraTracer 50 [hydraNode] $
-                  output "DecommitFinalized" ["headId" .= headId]
+                  output "DecommitFinalized" ["headId" .= headId, "decommitTxId" .= txId decommitTx]
 
                 send hydraNode $ input "Close" []
 

hydra-node/bench/tx-cost/Main.hs

@@ -30,7 +30,7 @@ import TxCost (
   computeCollectComCost,
   computeCommitCost,
   computeContestCost,
-  computeDecommitCost,
+  computeDecrementCost,
   computeFanOutCost,
   computeInitCost,
  )
@@ -77,7 +77,7 @@ writeTransactionCostMarkdown hdl = do
   initC <- costOfInit
   commitC <- costOfCommit
   collectComC <- costOfCollectCom
-  decommitC <- costOfDecommit
+  decrementC <- costOfDecrement
   closeC <- costOfClose
   contestC <- costOfContest
   abortC <- costOfAbort
@@ -92,7 +92,7 @@ writeTransactionCostMarkdown hdl = do
             [ initC
             , commitC
             , collectComC
-            , decommitC
+            , decrementC
             , closeC
             , contestC
             , abortC
@@ -231,12 +231,12 @@ costOfCollectCom = markdownCollectComCost <$> computeCollectComCost
           )
           stats
 
-costOfDecommit :: IO Text
-costOfDecommit = markdownDecommitCost <$> computeDecommitCost
+costOfDecrement :: IO Text
+costOfDecrement = markdownDecrementCost <$> computeDecrementCost
  where
-  markdownDecommitCost stats =
+  markdownDecrementCost stats =
     unlines $
-      [ "## Cost of Decommit Transaction"
+      [ "## Cost of Decrement Transaction"
       , ""
       , "| Parties | Tx size | % max Mem | % max CPU | Min fee ₳ |"
       , "| :------ | ------: | --------: | --------: | --------: |"