Skip to content
This repository has been archived by the owner on Dec 2, 2024. It is now read-only.

SCP-3305 SCP-3263 fixed Ledger.Constraints.Offchain.updateUtxoIndex #275

Merged
merged 1 commit into from
Jan 28, 2022
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 1 addition & 2 deletions playground-common/src/PSGenerator/Common.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down
15 changes: 7 additions & 8 deletions plutus-contract/src/Plutus/Contract/Wallet.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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]
Expand Down
2 changes: 1 addition & 1 deletion plutus-contract/src/Wallet/Emulator/Wallet.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
30 changes: 2 additions & 28 deletions plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs
Original file line number Diff line number Diff line change
Expand Up @@ -36,9 +36,6 @@ module Ledger.Constraints.OffChain(
, validityTimeRange
, emptyUnbalancedTx
, adjustUnbalancedTx
, ScriptOutput(..)
, toScriptOutput
, fromScriptOutput
, MkTxError(..)
, mkTx
, mkSomeTx
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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.
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
}

Expand All @@ -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)
}
)
Expand All @@ -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)
}
)
Expand All @@ -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
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
}

Expand All @@ -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)
}
)
Expand All @@ -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)
}
)
Expand All @@ -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
6 changes: 3 additions & 3 deletions plutus-use-cases/test/Spec/crowdfundingEmulatorTestOutput.txt
Original file line number Diff line number Diff line change
Expand Up @@ -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:
Expand Down