Move some functions back to the framework as we don't need them moved…

… anymore
input-output-hk · Feb 6, 2023 · de6047f · de6047f
1 parent 18d20fa
commit de6047f
Show file tree

Hide file tree

Showing 2 changed files with 49 additions and 58 deletions.
diff --git a/hydra-node/src/Hydra/Chain/Direct/Util.hs b/hydra-node/src/Hydra/Chain/Direct/Util.hs
@@ -6,24 +6,18 @@ module Hydra.Chain.Direct.Util where
 import Hydra.Prelude
 
 import qualified Cardano.Crypto.DSIGN as Crypto
-import qualified Cardano.Ledger.Alonzo.Data as Ledger
 import Cardano.Ledger.Alonzo.Tx (ValidatedTx (..))
 import Cardano.Ledger.Alonzo.TxWitness (TxWitness (..))
-import qualified Cardano.Ledger.Alonzo.TxWitness as Ledger
-import qualified Cardano.Ledger.Babbage.TxBody as Ledger
 import Cardano.Ledger.Crypto (DSIGN)
 import qualified Cardano.Ledger.SafeHash as SafeHash
-import Cardano.Ledger.Serialization (mkSized)
 import qualified Cardano.Ledger.TxIn as Ledger
 import Control.Tracer (nullTracer)
 import Data.Map.Strict ((!))
 import qualified Data.Map.Strict as Map
-import qualified Data.Sequence.Strict as StrictSeq
 import qualified Data.Set as Set
 import Hydra.Cardano.Api hiding (Block, SigningKey, VerificationKey)
 import qualified Hydra.Cardano.Api as Api
 import qualified Hydra.Cardano.Api as Shelley
-import Hydra.Ledger.Cardano (genTxOutAdaOnly)
 import Ouroboros.Consensus.Byron.Ledger.Config (CodecConfig (..))
 import Ouroboros.Consensus.Cardano (CardanoBlock)
 import Ouroboros.Consensus.Cardano.Block (
@@ -196,54 +190,3 @@ isMarkedOutput :: TxOut CtxUTxO -> Bool
 isMarkedOutput = \case
   (TxOut _ _ (TxOutDatumHash ha) _) -> ha == markerDatumHash
   _ -> False
-
------------------------------------------------------------------------------
--- TEST RELATED FUNCTIONS
------------------------------------------------------------------------------
-
--- | Apply some mapping function over a transaction's outputs.
-alterTxOuts ::
-  ([TxOut CtxTx] -> [TxOut CtxTx]) ->
-  Tx ->
-  Tx
-alterTxOuts fn tx =
-  Tx body' wits
- where
-  body' = ShelleyTxBody ledgerBody' scripts scriptData' mAuxData scriptValidity
-  ledgerBody' = ledgerBody{Ledger.outputs = ledgerOutputs'}
-
-  ledgerOutputs' = StrictSeq.fromList . map (mkSized . toLedgerTxOut . toCtxUTxOTxOut) $ outputs'
-
-  outputs' = fn . fmap fromLedgerTxOut . toList $ Ledger.outputs' ledgerBody
-
-  scriptData' = ensureDatums outputs' scriptData
-
-  ShelleyTxBody ledgerBody scripts scriptData mAuxData scriptValidity = body
-  Tx body wits = tx
-
-  -- Ensures the included datums of given 'TxOut's are included in the transactions' 'TxBodyScriptData'.
-  ensureDatums :: [TxOut CtxTx] -> TxBodyScriptData -> TxBodyScriptData
-  ensureDatums outs scriptData'' =
-    foldr ensureDatum scriptData'' outs
-   where
-    ensureDatum txOut sd =
-      case txOutDatum txOut of
-        d@(TxOutDatumInTx _) -> addDatum d sd
-        _ -> sd
-
--- | Adds given 'Datum' and corresponding hash to the transaction's scripts.
--- TODO: As we are creating the `TxOutDatum` from a known datum, passing a `TxOutDatum` is
--- pointless and requires more work than needed to check impossible variants.
-addDatum :: TxOutDatum CtxTx -> TxBodyScriptData -> TxBodyScriptData
-addDatum datum scriptData =
-  case datum of
-    TxOutDatumNone -> error "unexpected datum none"
-    TxOutDatumHash _ha -> error "hash only, expected full datum"
-    TxOutDatumInline _sd -> error "not useful for inline datums"
-    TxOutDatumInTx sd ->
-      case scriptData of
-        TxBodyNoScriptData -> error "TxBodyNoScriptData unexpected"
-        TxBodyScriptData (Ledger.TxDats dats) redeemers ->
-          let dat = toLedgerData sd
-              newDats = Ledger.TxDats $ Map.insert (Ledger.hashData dat) dat dats
-           in TxBodyScriptData newDats redeemers
diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs
@@ -136,13 +136,14 @@ import qualified Cardano.Ledger.Alonzo.Data as Ledger
 import qualified Cardano.Ledger.Alonzo.Scripts as Ledger
 import qualified Cardano.Ledger.Alonzo.TxWitness as Ledger
 import qualified Cardano.Ledger.Babbage.TxBody as Ledger
+import Cardano.Ledger.Serialization (mkSized)
 import qualified Data.Map as Map
+import qualified Data.Sequence.Strict as StrictSeq
 import qualified Data.Set as Set
 import Hydra.Chain.Direct.Contract.Gen (genForParty)
 import Hydra.Chain.Direct.Fixture (testPolicyId)
 import qualified Hydra.Chain.Direct.Fixture as Fixture
 import Hydra.Chain.Direct.Tx (assetNameFromVerificationKey)
-import Hydra.Chain.Direct.Util (addDatum, alterTxOuts)
 import qualified Hydra.Contract.Head as Head
 import qualified Hydra.Contract.HeadState as Head
 import qualified Hydra.Data.Party as Data (Party)
@@ -429,6 +430,23 @@ isHeadOutput TxOut{txOutAddress = addr} = addr == headAddress
   headAddress = mkScriptAddress @PlutusScriptV2 Fixture.testNetworkId headScript
   headScript = fromPlutusScript Head.validatorScript
 
+-- | Adds given 'Datum' and corresponding hash to the transaction's scripts.
+-- TODO: As we are creating the `TxOutDatum` from a known datum, passing a `TxOutDatum` is
+-- pointless and requires more work than needed to check impossible variants.
+addDatum :: TxOutDatum CtxTx -> TxBodyScriptData -> TxBodyScriptData
+addDatum datum scriptData =
+  case datum of
+    TxOutDatumNone -> error "unexpected datum none"
+    TxOutDatumHash _ha -> error "hash only, expected full datum"
+    TxOutDatumInline _sd -> error "not useful for inline datums"
+    TxOutDatumInTx sd ->
+      case scriptData of
+        TxBodyNoScriptData -> error "TxBodyNoScriptData unexpected"
+        TxBodyScriptData (Ledger.TxDats dats) redeemers ->
+          let dat = toLedgerData sd
+              newDats = Ledger.TxDats $ Map.insert (Ledger.hashData dat) dat dats
+           in TxBodyScriptData newDats redeemers
+
 changeHeadOutputDatum :: (Head.State -> Head.State) -> TxOut CtxTx -> TxOut CtxTx
 changeHeadOutputDatum fn txOut =
   case txOutDatum txOut of
@@ -456,6 +474,16 @@ addParticipationTokens parties txOut =
         | cardanoVk <- genForParty genVerificationKey <$> parties
         ]
 
+-- | Ensures the included datums of given 'TxOut's are included in the transactions' 'TxBodyScriptData'.
+ensureDatums :: [TxOut CtxTx] -> TxBodyScriptData -> TxBodyScriptData
+ensureDatums outs scriptData =
+  foldr ensureDatum scriptData outs
+ where
+  ensureDatum txOut sd =
+    case txOutDatum txOut of
+      d@(TxOutDatumInTx _) -> addDatum d sd
+      _ -> sd
+
 -- | Alter a transaction's  redeemers map given some mapping function.
 alterRedeemers ::
   ( Ledger.RdmrPtr ->
@@ -523,6 +551,26 @@ alterTxIns fn tx =
 
   Tx body wits = tx
 
+-- | Apply some mapping function over a transaction's outputs.
+alterTxOuts ::
+  ([TxOut CtxTx] -> [TxOut CtxTx]) ->
+  Tx ->
+  Tx
+alterTxOuts fn tx =
+  Tx body' wits
+ where
+  body' = ShelleyTxBody ledgerBody' scripts scriptData' mAuxData scriptValidity
+  ledgerBody' = ledgerBody{Ledger.outputs = ledgerOutputs'}
+
+  ledgerOutputs' = StrictSeq.fromList . map (mkSized . toLedgerTxOut . toCtxUTxOTxOut) $ outputs'
+
+  outputs' = fn . fmap fromLedgerTxOut . toList $ Ledger.outputs' ledgerBody
+
+  scriptData' = ensureDatums outputs' scriptData
+
+  ShelleyTxBody ledgerBody scripts scriptData mAuxData scriptValidity = body
+  Tx body wits = tx
+
 -- | Generates an output that pays to some arbitrary pubkey.
 anyPayToPubKeyTxOut :: Gen (TxOut ctx)
 anyPayToPubKeyTxOut = genKeyPair >>= genOutput . fst