SCP-3305 reverted #57

IntersectMBO · Jan 27, 2022 · d08145b · d08145b
1 parent 897efdd
commit d08145b
Show file tree

Hide file tree

Showing 7 changed files with 24 additions and 134 deletions.
diff --git a/playground-common/src/PSGenerator/Common.hs b/playground-common/src/PSGenerator/Common.hs
@@ -22,7 +22,7 @@ import Ledger (Address, BlockId, ChainIndexTxOut, DatumHash, MintingPolicy, OnCh
                PubKey, PubKeyHash, RedeemerPtr, ScriptTag, Signature, StakePubKey, StakePubKeyHash, StakeValidator, Tx,
                TxId, TxIn, TxInType, TxOut, TxOutRef, TxOutTx, UtxoIndex, ValidationPhase, Validator)
 import Ledger.Ada (Ada)
-import Ledger.Constraints.OffChain (MkTxError, ScriptOutput, UnbalancedTx)
+import Ledger.Constraints.OffChain (MkTxError, UnbalancedTx)
 import Ledger.Credential (Credential, StakingCredential)
 import Ledger.DCert (DCert)
 import Ledger.Index (ExCPU, ExMemory, ScriptType, ScriptValidationEvent, ValidationError)
@@ -405,7 +405,6 @@ ledgerTypes =
     , equal . genericShow . argonaut $ mkSumType @WriteBalancedTxResponse
     , equal . genericShow . argonaut $ mkSumType @ActiveEndpoint
     , equal . genericShow . argonaut $ mkSumType @UnbalancedTx
-    , equal . genericShow . argonaut $ mkSumType @ScriptOutput
     , order . equal . genericShow . argonaut $ mkSumType @TxValidity
     , equal . genericShow . argonaut $ mkSumType @TxOutState
     , equal . genericShow . argonaut $ mkSumType @(RollbackState A)

diff --git a/plutus-contract/src/Plutus/Contract/Wallet.hs b/plutus-contract/src/Plutus/Contract/Wallet.hs
@@ -47,8 +47,7 @@ import GHC.Generics (Generic)
 import Ledger qualified as Plutus
 import Ledger.Ada qualified as Ada
 import Ledger.Constraints (mustPayToPubKey)
-import Ledger.Constraints.OffChain (ScriptOutput (ScriptOutput),
-                                    UnbalancedTx (UnbalancedTx, unBalancedTxRequiredSignatories, unBalancedTxTx, unBalancedTxUtxoIndex),
+import Ledger.Constraints.OffChain (UnbalancedTx (UnbalancedTx, unBalancedTxRequiredSignatories, unBalancedTxTx, unBalancedTxUtxoIndex),
                                     adjustUnbalancedTx, mkTx)
 import Ledger.Tx (CardanoTx, TxOutRef, getCardanoTxInputs, txInRef)
 import Plutus.Contract.CardanoAPI qualified as CardanoAPI
@@ -251,19 +250,19 @@ mkPartialTx requiredSigners params networkId =
       fmap (C.makeSignedTransaction [])
     . CardanoAPI.toCardanoTxBody requiredSigners (Just params) networkId
 
-mkInputs :: C.NetworkId -> Map Plutus.TxOutRef ScriptOutput -> Either CardanoAPI.ToCardanoError [ExportTxInput]
+mkInputs :: C.NetworkId -> Map Plutus.TxOutRef Plutus.TxOut -> Either CardanoAPI.ToCardanoError [ExportTxInput]
 mkInputs networkId = traverse (uncurry (toExportTxInput networkId)) . Map.toList
 
-toExportTxInput :: C.NetworkId -> Plutus.TxOutRef -> ScriptOutput -> Either CardanoAPI.ToCardanoError ExportTxInput
-toExportTxInput networkId Plutus.TxOutRef{Plutus.txOutRefId, Plutus.txOutRefIdx} (ScriptOutput vh value dh) = do
-    cardanoValue <- CardanoAPI.toCardanoValue value
+toExportTxInput :: C.NetworkId -> Plutus.TxOutRef -> Plutus.TxOut -> Either CardanoAPI.ToCardanoError ExportTxInput
+toExportTxInput networkId Plutus.TxOutRef{Plutus.txOutRefId, Plutus.txOutRefIdx} Plutus.TxOut{Plutus.txOutAddress, Plutus.txOutValue, Plutus.txOutDatumHash} = do
+    cardanoValue <- CardanoAPI.toCardanoValue txOutValue
     let otherQuantities = mapMaybe (\case { (C.AssetId policyId assetName, quantity) -> Just (policyId, assetName, quantity); _ -> Nothing }) $ C.valueToList cardanoValue
     ExportTxInput
         <$> CardanoAPI.toCardanoTxId txOutRefId
         <*> pure (C.TxIx $ fromInteger txOutRefIdx)
-        <*> CardanoAPI.toCardanoAddress networkId (Plutus.scriptHashAddress vh)
+        <*> CardanoAPI.toCardanoAddress networkId txOutAddress
         <*> pure (C.selectLovelace cardanoValue)
-        <*> either (const $ pure Nothing) (pure . Just) (CardanoAPI.toCardanoScriptDataHash dh)
+        <*> sequence (CardanoAPI.toCardanoScriptDataHash <$> txOutDatumHash)
         <*> pure otherQuantities
 
 mkRedeemers :: Plutus.Tx -> Either CardanoAPI.ToCardanoError [ExportTxRedeemer]

diff --git a/plutus-contract/src/Wallet/Emulator/Wallet.hs b/plutus-contract/src/Wallet/Emulator/Wallet.hs
@@ -326,7 +326,7 @@ validateTxAndAddFees feeCfg slotCfg ownTxOuts utx = do
     -- Balance and sign just for validation
     tx <- handleBalanceTx ownTxOuts utx
     signedTx <- handleAddSignature tx
-    let utxoIndex        = Ledger.UtxoIndex $ fmap Ledger.toTxOut $ (U.fromScriptOutput <$> unBalancedTxUtxoIndex utx) <> ownTxOuts
+    let utxoIndex        = Ledger.UtxoIndex $ unBalancedTxUtxoIndex utx <> fmap Ledger.toTxOut ownTxOuts
         ((e, _), events) = Ledger.runValidation (Ledger.validateTransactionOffChain signedTx) (Ledger.ValidationCtx utxoIndex slotCfg)
     for_ e $ \(phase, ve) -> do
         logWarn $ ValidationFailed phase (Ledger.txId tx) tx ve events

diff --git a/plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs b/plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs
@@ -36,9 +36,6 @@ module Ledger.Constraints.OffChain(
     , validityTimeRange
     , emptyUnbalancedTx
     , adjustUnbalancedTx
-    , ScriptOutput(..)
-    , toScriptOutput
-    , fromScriptOutput
     , MkTxError(..)
     , mkTx
     , mkSomeTx
@@ -185,37 +182,14 @@ ownPaymentPubKeyHash pkh = mempty { slOwnPaymentPubKeyHash = Just pkh }
 ownStakePubKeyHash :: StakePubKeyHash -> ScriptLookups a
 ownStakePubKeyHash skh = mempty { slOwnStakePubKeyHash = Just skh }
 
-data ScriptOutput =
-    ScriptOutput
-        { scriptOutputValidatorHash :: ValidatorHash
-        , scriptOutputValue         :: Value
-        , scriptOutputDatumHash     :: DatumHash
-        }
-    deriving stock (Eq, Generic, Show)
-    deriving anyclass (FromJSON, ToJSON, OpenApi.ToSchema)
-
-toScriptOutput :: ChainIndexTxOut -> Maybe ScriptOutput
-toScriptOutput (Tx.ScriptChainIndexTxOut _ validatorOrHash datumOrHash v)
-    = Just $ ScriptOutput (either id validatorHash validatorOrHash) v (either id datumHash datumOrHash)
-toScriptOutput Tx.PublicKeyChainIndexTxOut{}
-    = Nothing
-
-fromScriptOutput :: ScriptOutput -> ChainIndexTxOut
-fromScriptOutput (ScriptOutput vh v dh) =
-    Tx.ScriptChainIndexTxOut (Address.scriptHashAddress vh) (Left vh) (Left dh) v
-
-instance Pretty ScriptOutput where
-    pretty ScriptOutput{scriptOutputValidatorHash, scriptOutputValue} =
-        hang 2 $ vsep ["-" <+> pretty scriptOutputValue <+> "addressed to", pretty scriptOutputValidatorHash]
-
 -- | An unbalanced transaction. It needs to be balanced and signed before it
 --   can be submitted to the ledeger. See note [Submitting transactions from
 --   Plutus contracts] in 'Plutus.Contract.Wallet'.
 data UnbalancedTx =
     UnbalancedTx
         { unBalancedTxTx                  :: Tx
         , unBalancedTxRequiredSignatories :: Map PaymentPubKeyHash (Maybe PaymentPubKey)
-        , unBalancedTxUtxoIndex           :: Map TxOutRef ScriptOutput
+        , unBalancedTxUtxoIndex           :: Map TxOutRef TxOut
         , unBalancedTxValidityTimeRange   :: POSIXTimeRange
         }
     deriving stock (Eq, Generic, Show)
@@ -431,7 +405,7 @@ updateUtxoIndex
     => m ()
 updateUtxoIndex = do
     ScriptLookups{slTxOutputs} <- ask
-    unbalancedTx . utxoIndex <>= Map.mapMaybe toScriptOutput slTxOutputs
+    unbalancedTx . utxoIndex <>= fmap Tx.toTxOut slTxOutputs
 
 -- | Add a typed input, checking the type of the output it spends. Return the value
 --   of the spent output.

diff --git a/plutus-pab-executables/demo/pab-nami/client/generated/Ledger/Constraints/OffChain.purs b/plutus-pab-executables/demo/pab-nami/client/generated/Ledger/Constraints/OffChain.purs
@@ -23,8 +23,7 @@ import Ledger.Typed.Tx (ConnectionError)
 import Plutus.V1.Ledger.Interval (Interval)
 import Plutus.V1.Ledger.Scripts (DatumHash)
 import Plutus.V1.Ledger.Time (POSIXTime)
-import Plutus.V1.Ledger.Tx (Tx, TxOutRef)
-import Plutus.V1.Ledger.Value (Value)
+import Plutus.V1.Ledger.Tx (Tx, TxOut, TxOutRef)
 import Type.Proxy (Proxy(Proxy))
 import Data.Argonaut.Decode.Aeson as D
 import Data.Argonaut.Encode.Aeson as E
@@ -132,50 +131,10 @@ _CannotSatisfyAny = prism' (const CannotSatisfyAny) case _ of
 
 --------------------------------------------------------------------------------
 
-newtype ScriptOutput = ScriptOutput
-  { scriptOutputValidatorHash :: String
-  , scriptOutputValue :: Value
-  , scriptOutputDatumHash :: DatumHash
-  }
-
-derive instance Eq ScriptOutput
-
-instance Show ScriptOutput where
-  show a = genericShow a
-
-instance EncodeJson ScriptOutput where
-  encodeJson = defer \_ -> E.encode $ unwrap >$<
-    ( E.record
-        { scriptOutputValidatorHash: E.value :: _ String
-        , scriptOutputValue: E.value :: _ Value
-        , scriptOutputDatumHash: E.value :: _ DatumHash
-        }
-    )
-
-instance DecodeJson ScriptOutput where
-  decodeJson = defer \_ -> D.decode $
-    ( ScriptOutput <$> D.record "ScriptOutput"
-        { scriptOutputValidatorHash: D.value :: _ String
-        , scriptOutputValue: D.value :: _ Value
-        , scriptOutputDatumHash: D.value :: _ DatumHash
-        }
-    )
-
-derive instance Generic ScriptOutput _
-
-derive instance Newtype ScriptOutput _
-
---------------------------------------------------------------------------------
-
-_ScriptOutput :: Iso' ScriptOutput { scriptOutputValidatorHash :: String, scriptOutputValue :: Value, scriptOutputDatumHash :: DatumHash }
-_ScriptOutput = _Newtype
-
---------------------------------------------------------------------------------
-
 newtype UnbalancedTx = UnbalancedTx
   { unBalancedTxTx :: Tx
   , unBalancedTxRequiredSignatories :: Map PaymentPubKeyHash (Maybe PaymentPubKey)
-  , unBalancedTxUtxoIndex :: Map TxOutRef ScriptOutput
+  , unBalancedTxUtxoIndex :: Map TxOutRef TxOut
   , unBalancedTxValidityTimeRange :: Interval POSIXTime
   }
 
@@ -189,7 +148,7 @@ instance EncodeJson UnbalancedTx where
     ( E.record
         { unBalancedTxTx: E.value :: _ Tx
         , unBalancedTxRequiredSignatories: (E.dictionary E.value (E.maybe E.value)) :: _ (Map PaymentPubKeyHash (Maybe PaymentPubKey))
-        , unBalancedTxUtxoIndex: (E.dictionary E.value E.value) :: _ (Map TxOutRef ScriptOutput)
+        , unBalancedTxUtxoIndex: (E.dictionary E.value E.value) :: _ (Map TxOutRef TxOut)
         , unBalancedTxValidityTimeRange: E.value :: _ (Interval POSIXTime)
         }
     )
@@ -199,7 +158,7 @@ instance DecodeJson UnbalancedTx where
     ( UnbalancedTx <$> D.record "UnbalancedTx"
         { unBalancedTxTx: D.value :: _ Tx
         , unBalancedTxRequiredSignatories: (D.dictionary D.value (D.maybe D.value)) :: _ (Map PaymentPubKeyHash (Maybe PaymentPubKey))
-        , unBalancedTxUtxoIndex: (D.dictionary D.value D.value) :: _ (Map TxOutRef ScriptOutput)
+        , unBalancedTxUtxoIndex: (D.dictionary D.value D.value) :: _ (Map TxOutRef TxOut)
         , unBalancedTxValidityTimeRange: D.value :: _ (Interval POSIXTime)
         }
     )
@@ -210,5 +169,5 @@ derive instance Newtype UnbalancedTx _
 
 --------------------------------------------------------------------------------
 
-_UnbalancedTx :: Iso' UnbalancedTx { unBalancedTxTx :: Tx, unBalancedTxRequiredSignatories :: Map PaymentPubKeyHash (Maybe PaymentPubKey), unBalancedTxUtxoIndex :: Map TxOutRef ScriptOutput, unBalancedTxValidityTimeRange :: Interval POSIXTime }
+_UnbalancedTx :: Iso' UnbalancedTx { unBalancedTxTx :: Tx, unBalancedTxRequiredSignatories :: Map PaymentPubKeyHash (Maybe PaymentPubKey), unBalancedTxUtxoIndex :: Map TxOutRef TxOut, unBalancedTxValidityTimeRange :: Interval POSIXTime }
 _UnbalancedTx = _Newtype
diff --git a/plutus-playground-client/generated/Ledger/Constraints/OffChain.purs b/plutus-playground-client/generated/Ledger/Constraints/OffChain.purs
@@ -23,8 +23,7 @@ import Ledger.Typed.Tx (ConnectionError)
 import Plutus.V1.Ledger.Interval (Interval)
 import Plutus.V1.Ledger.Scripts (DatumHash)
 import Plutus.V1.Ledger.Time (POSIXTime)
-import Plutus.V1.Ledger.Tx (Tx, TxOutRef)
-import Plutus.V1.Ledger.Value (Value)
+import Plutus.V1.Ledger.Tx (Tx, TxOut, TxOutRef)
 import Type.Proxy (Proxy(Proxy))
 import Data.Argonaut.Decode.Aeson as D
 import Data.Argonaut.Encode.Aeson as E
@@ -132,50 +131,10 @@ _CannotSatisfyAny = prism' (const CannotSatisfyAny) case _ of
 
 --------------------------------------------------------------------------------
 
-newtype ScriptOutput = ScriptOutput
-  { scriptOutputValidatorHash :: String
-  , scriptOutputValue :: Value
-  , scriptOutputDatumHash :: DatumHash
-  }
-
-derive instance Eq ScriptOutput
-
-instance Show ScriptOutput where
-  show a = genericShow a
-
-instance EncodeJson ScriptOutput where
-  encodeJson = defer \_ -> E.encode $ unwrap >$<
-    ( E.record
-        { scriptOutputValidatorHash: E.value :: _ String
-        , scriptOutputValue: E.value :: _ Value
-        , scriptOutputDatumHash: E.value :: _ DatumHash
-        }
-    )
-
-instance DecodeJson ScriptOutput where
-  decodeJson = defer \_ -> D.decode $
-    ( ScriptOutput <$> D.record "ScriptOutput"
-        { scriptOutputValidatorHash: D.value :: _ String
-        , scriptOutputValue: D.value :: _ Value
-        , scriptOutputDatumHash: D.value :: _ DatumHash
-        }
-    )
-
-derive instance Generic ScriptOutput _
-
-derive instance Newtype ScriptOutput _
-
---------------------------------------------------------------------------------
-
-_ScriptOutput :: Iso' ScriptOutput { scriptOutputValidatorHash :: String, scriptOutputValue :: Value, scriptOutputDatumHash :: DatumHash }
-_ScriptOutput = _Newtype
-
---------------------------------------------------------------------------------
-
 newtype UnbalancedTx = UnbalancedTx
   { unBalancedTxTx :: Tx
   , unBalancedTxRequiredSignatories :: Map PaymentPubKeyHash (Maybe PaymentPubKey)
-  , unBalancedTxUtxoIndex :: Map TxOutRef ScriptOutput
+  , unBalancedTxUtxoIndex :: Map TxOutRef TxOut
   , unBalancedTxValidityTimeRange :: Interval POSIXTime
   }
 
@@ -189,7 +148,7 @@ instance EncodeJson UnbalancedTx where
     ( E.record
         { unBalancedTxTx: E.value :: _ Tx
         , unBalancedTxRequiredSignatories: (E.dictionary E.value (E.maybe E.value)) :: _ (Map PaymentPubKeyHash (Maybe PaymentPubKey))
-        , unBalancedTxUtxoIndex: (E.dictionary E.value E.value) :: _ (Map TxOutRef ScriptOutput)
+        , unBalancedTxUtxoIndex: (E.dictionary E.value E.value) :: _ (Map TxOutRef TxOut)
         , unBalancedTxValidityTimeRange: E.value :: _ (Interval POSIXTime)
         }
     )
@@ -199,7 +158,7 @@ instance DecodeJson UnbalancedTx where
     ( UnbalancedTx <$> D.record "UnbalancedTx"
         { unBalancedTxTx: D.value :: _ Tx
         , unBalancedTxRequiredSignatories: (D.dictionary D.value (D.maybe D.value)) :: _ (Map PaymentPubKeyHash (Maybe PaymentPubKey))
-        , unBalancedTxUtxoIndex: (D.dictionary D.value D.value) :: _ (Map TxOutRef ScriptOutput)
+        , unBalancedTxUtxoIndex: (D.dictionary D.value D.value) :: _ (Map TxOutRef TxOut)
         , unBalancedTxValidityTimeRange: D.value :: _ (Interval POSIXTime)
         }
     )
@@ -210,5 +169,5 @@ derive instance Newtype UnbalancedTx _
 
 --------------------------------------------------------------------------------
 
-_UnbalancedTx :: Iso' UnbalancedTx { unBalancedTxTx :: Tx, unBalancedTxRequiredSignatories :: Map PaymentPubKeyHash (Maybe PaymentPubKey), unBalancedTxUtxoIndex :: Map TxOutRef ScriptOutput, unBalancedTxValidityTimeRange :: Interval POSIXTime }
+_UnbalancedTx :: Iso' UnbalancedTx { unBalancedTxTx :: Tx, unBalancedTxRequiredSignatories :: Map PaymentPubKeyHash (Maybe PaymentPubKey), unBalancedTxUtxoIndex :: Map TxOutRef TxOut, unBalancedTxValidityTimeRange :: Interval POSIXTime }
 _UnbalancedTx = _Newtype
diff --git a/plutus-use-cases/test/Spec/crowdfundingEmulatorTestOutput.txt b/plutus-use-cases/test/Spec/crowdfundingEmulatorTestOutput.txt
@@ -176,13 +176,13 @@ Slot 20: W872cb83: Balancing an unbalanced transaction:
                      Utxo index:
                        ( 1dc8c21dc6a9ae5cecd57646a344745dba3d2d9929e30498c7da36f0a8ff0c78!1
                        , - Value (Map [(,Map [("",10000000)])]) addressed to
-                           9fe341a3110281ecdbcf3d79ce1c2d95f6afa1452377e318e610b586 )
+                           ScriptCredential: 9fe341a3110281ecdbcf3d79ce1c2d95f6afa1452377e318e610b586 (no staking credential) )
                        ( 3885731ef1d31f92492628bdb6982c22de9af5eb4286c4cde47c6f2f62156eea!1
                        , - Value (Map [(,Map [("",10000000)])]) addressed to
-                           9fe341a3110281ecdbcf3d79ce1c2d95f6afa1452377e318e610b586 )
+                           ScriptCredential: 9fe341a3110281ecdbcf3d79ce1c2d95f6afa1452377e318e610b586 (no staking credential) )
                        ( d90b088b39ea27cd845200fc4242f7aa048eaba5dd5f33ff0757ee5bb22d0ff9!1
                        , - Value (Map [(,Map [("",2500000)])]) addressed to
-                           9fe341a3110281ecdbcf3d79ce1c2d95f6afa1452377e318e610b586 )
+                           ScriptCredential: 9fe341a3110281ecdbcf3d79ce1c2d95f6afa1452377e318e610b586 (no staking credential) )
                      Validity range:
                        [ POSIXTime 1596059111000 , POSIXTime 1596059120999 ]
 Slot 20: W872cb83: Finished balancing: