From 91364d95226737c056f8a1881cfded4a701bd73f Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Fri, 14 Feb 2025 18:07:07 +0100
Subject: [PATCH] txOutRefToTxSkelOut

---
 CHANGELOG.md                          |  3 +++
 src/Cooked/Conversion/ToCredential.hs |  4 ++++
 src/Cooked/MockChain/BlockChain.hs    | 30 ++++++++++++++++++++++++++-
 src/Cooked/Skeleton.hs                |  3 +++
 4 files changed, 39 insertions(+), 1 deletion(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index e4425056e..6d2d05a4d 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -28,6 +28,9 @@
   be used on a redeemer to manually attach a reference input (which does not
   necessarily have to contain the right reference script).
 - Capability to test the result of a mockchain run based on the log entries.
+- `txOutRefToTxSkelOut` helper to query the mock chain for recreating a
+  `TxSkelOut` from a `TxOutRef`. This is very useful when using Tweaks that need
+  to pay back an existing output with a slight modification.
 
 ### Removed
 
diff --git a/src/Cooked/Conversion/ToCredential.hs b/src/Cooked/Conversion/ToCredential.hs
index d5c1c1808..d781bf054 100644
--- a/src/Cooked/Conversion/ToCredential.hs
+++ b/src/Cooked/Conversion/ToCredential.hs
@@ -10,6 +10,10 @@ import PlutusLedgerApi.V3 qualified as Api
 class ToCredential a where
   toCredential :: a -> Api.Credential
 
+instance (ToCredential a, ToCredential b) => ToCredential (Either a b) where
+  toCredential (Left l) = toCredential l
+  toCredential (Right r) = toCredential r
+
 instance ToCredential Api.Credential where
   toCredential = id
 
diff --git a/src/Cooked/MockChain/BlockChain.hs b/src/Cooked/MockChain/BlockChain.hs
index 869811d6e..a3a41cb37 100644
--- a/src/Cooked/MockChain/BlockChain.hs
+++ b/src/Cooked/MockChain/BlockChain.hs
@@ -49,6 +49,7 @@ module Cooked.MockChain.BlockChain
     validateTxSkel_,
     txSkelProposalsDeposit,
     govActionDeposit,
+    txOutRefToTxSkelOut,
   )
 where
 
@@ -79,7 +80,7 @@ import Ledger.Index qualified as Ledger
 import Ledger.Slot qualified as Ledger
 import Ledger.Tx qualified as Ledger
 import Ledger.Tx.CardanoAPI qualified as Ledger
-import ListT
+import ListT hiding (null)
 import Optics.Core
 import Plutus.Script.Utils.Scripts qualified as Script
 import PlutusLedgerApi.V3 qualified as Api
@@ -381,6 +382,33 @@ txSkelInputDataAsHashes skel = do
   (Map.elems -> inputTxOuts) <- txSkelInputUtxos skel
   catMaybes <$> mapM outputToDatumHashM inputTxOuts
 
+-- | This creates a payment from an existing TxOut. This is not trivial because
+-- we need to reconstruct a bunch of information using data withing the blockchain
+txOutRefToTxSkelOut :: (MonadBlockChainBalancing m) => Api.TxOutRef -> m TxSkelOut
+txOutRefToTxSkelOut oRef = do
+  Just txOut@(Api.TxOut (Api.Address cred _) _ dat refS) <- txOutByRef oRef
+  target <- case cred of
+    Api.PubKeyCredential pkh -> return $ Left pkh
+    Api.ScriptCredential (Api.ScriptHash sh) -> do
+      Just val <- validatorFromHash (Script.ValidatorHash sh)
+      return $ Right val
+  datum <- case dat of
+    Api.NoOutputDatum -> return TxSkelOutNoDatum
+    Api.OutputDatumHash hash -> do
+      Just (Api.Datum dat') <- datumFromHash hash
+      return $ TxSkelOutDatum dat' -- TODO: investigate between this and TxSkelOutDatum
+    Api.OutputDatum (Api.Datum dat') -> return $ TxSkelOutInlineDatum dat'
+  refScript <- case refS of
+    Nothing -> return Nothing
+    Just (Api.ScriptHash sh) -> validatorFromHash (Script.ValidatorHash sh)
+  return $
+    Pays $
+      (fromAbstractOutput txOut)
+        { concreteOutputOwner = target,
+          concreteOutputDatum = datum,
+          concreteOutputReferenceScript = refScript
+        }
+
 -- ** Slot and Time Management
 
 -- $slotandtime
diff --git a/src/Cooked/Skeleton.hs b/src/Cooked/Skeleton.hs
index 4d119a45f..97e15cb27 100644
--- a/src/Cooked/Skeleton.hs
+++ b/src/Cooked/Skeleton.hs
@@ -762,6 +762,9 @@ instance IsTxSkelOutAllowedOwner Api.PubKeyHash where
 instance IsTxSkelOutAllowedOwner (Script.TypedValidator a) where
   toPKHOrValidator = Right . Script.tvValidator
 
+instance IsTxSkelOutAllowedOwner (Either Api.PubKeyHash (Script.Versioned Script.Validator)) where
+  toPKHOrValidator = id
+
 -- | Transaction outputs. The 'Pays' constructor is really general, and you'll
 -- probably want to use one of the smart constructors like 'paysScript' or
 -- 'paysPK' in most cases.