Add MutateCommittedAddress mutator
Also adds some helpers to Hydra.Ledger.Cardano
Also adds some helpers to Hydra.Ledger.Cardano
lovelaceToTxOutValue :: Lovelace -> TxOutValue AlonzoEra
lovelaceToTxOutValue lovelace = TxOutValue MultiAssetInAlonzoEra (lovelaceToValue lovelace)
txOutAddress :: TxOut ctx Era -> AddressInEra Era
txOutAddress (TxOut addr _ _) =
addr
txOutValue :: TxOut ctx Era -> Value
txOutValue (TxOut _ value _) =
txOutValueToValue value
TxBodyNoScriptData -> mempty
TxBodyScriptData _ (Ledger.Alonzo.TxDats m) _ -> m
modifyTxOutDatum ::
(TxOutDatum ctx0 Era -> TxOutDatum ctx1 Era) ->
TxOut ctx0 Era ->
TxOut ctx1 Era
modifyTxOutDatum fn (TxOut addr value dat) =
TxOut addr value (fn dat)
modifyTxOutAddress ::
(AddressInEra Era -> AddressInEra Era) ->
TxOut ctx Era ->
TxOut ctx Era
modifyTxOutAddress fn (TxOut addr value dat) =
TxOut (fn addr) value dat
modifyTxOutValue ::
(Value -> Value) ->
modifyTxOutValue fn (TxOut addr value dat) =
TxOut addr (mkTxOutValue $ fn $ txOutValueToValue value) dat
modifyTxOutDatum ::
(TxOutDatum ctx0 Era -> TxOutDatum ctx1 Era) ->
TxOut ctx0 Era ->
TxOut ctx1 Era
modifyTxOutDatum fn (TxOut addr value dat) =
TxOut addr value (fn dat)
-- | Find first 'TxOut' which pays to given address and also return the
-- corresponding 'TxIn' to reference it.
findTxOutByAddress :: AddressInEra era -> TxBody era -> Maybe (TxIn, TxOut CtxTx era)
-- * Generators
genVerificationKey :: Gen (VerificationKey PaymentKey)
genVerificationKey = fst <$> genKeyPair
genKeyPair :: Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
genKeyPair = do
-- NOTE: not using 'genKeyDSIGN' purposely here, it is not pure and does not
output <- scale (const 1) $ genOutput vk
pure $ Utxo $ Map.singleton (fromLedgerTxIn input) output
-- | NOTE: See note on 'mkVkAddress' about 'NetworkId'.
genAddressInEra :: NetworkId -> Gen (AddressInEra Era)
genAddressInEra networkId =
mkVkAddress networkId <$> genVerificationKey
genValue :: Gen Value
genValue = txOutValue <$> (genKeyPair >>= (genOutput . fst))
import Hydra.Chain.Direct.Contract.Mutation (
Mutation (..),
SomeMutation (..),
isInitialOutput,
)
import qualified Hydra.Chain.Direct.Fixture as Fixture
import Hydra.Chain.Direct.Tx (commitTx, mkInitialOutput)
TxOut (TxOut),
Utxo,
VerificationKey,
genAddressInEra,
genOutput,
genValue,
getOutputs,
lovelaceToValue,
mkTxOutValue,
modifyTxOutAddress,
modifyTxOutValue,
singletonUtxo,
toUtxoContext,
utxoPairs,
txOutAddress,
txOutValue,
verificationKeyHash,
)
import Hydra.Party (Party)
import Test.QuickCheck (elements, oneof, suchThat)
import Test.QuickCheck (oneof, suchThat)
--
-- CommitTx
where
lookupUtxo =
singletonUtxo (initialInput, toUtxoContext initialOutput)
<> singletonUtxo committedUtxo
<> singletonUtxo healthyCommittedUtxo
tx =
commitTx
Fixture.testNetworkId
commitParty
(Just committedUtxo)
(Just healthyCommittedUtxo)
(initialInput, initialPubKeyHash)
initialInput = generateWith arbitrary 42
initialPubKeyHash = verificationKeyHash commitVerificationKey
-- NOTE: An 8₳ output which is currently addressed to some arbitrary key.
committedUtxo :: (TxIn, TxOut CtxUTxO Era)
committedUtxo = flip generateWith 42 $ do
txIn <- arbitrary
txOut <- modifyTxOutValue (const $ lovelaceToValue 8_000_000) <$> (genOutput =<< arbitrary)
pure (txIn, txOut)
commitVerificationKey :: VerificationKey PaymentKey
commitVerificationKey = generateWith arbitrary 42
commitParty :: Party
commitParty = generateWith arbitrary 42
-- NOTE: An 8₳ output which is currently addressed to some arbitrary key.
healthyCommittedUtxo :: (TxIn, TxOut CtxUTxO Era)
healthyCommittedUtxo = flip generateWith 42 $ do
txIn <- arbitrary
txOut <- modifyTxOutValue (const $ lovelaceToValue 8_000_000) <$> (genOutput =<< arbitrary)
pure (txIn, txOut)
data CommitMutation
= MutateCommitOutputValue
| MutateComittedValue
| MutateCommittedValue
| MutateCommittedAddress
deriving (Generic, Show, Enum, Bounded)
genCommitMutation :: (CardanoTx, Utxo) -> Gen SomeMutation
genCommitMutation (tx, utxo) =
genCommitMutation (tx, _utxo) =
oneof
[ SomeMutation MutateCommitOutputValue . ChangeOutput 0 <$> do
mutatedValue <- (mkTxOutValue <$> genValue) `suchThat` (/= commitOutputValue)
pure $ TxOut commitOutputAddress mutatedValue commitOutputDatum
, SomeMutation MutateComittedValue <$> do
(comittedTxIn, _) <- elements comittedTxIns
newResolvedTxIn <- genOutput =<< arbitrary
pure $ ChangeInput comittedTxIn newResolvedTxIn
, SomeMutation MutateCommittedValue <$> do
mutatedValue <- genValue `suchThat` (/= committedOutputValue)
let mutatedOutput = modifyTxOutValue (const mutatedValue) committedTxOut
pure $ ChangeInput committedTxIn mutatedOutput
, SomeMutation MutateCommittedAddress <$> do
mutatedAddress <- genAddressInEra Fixture.testNetworkId `suchThat` (/= committedAddress)
let mutatedOutput = modifyTxOutAddress (const mutatedAddress) committedTxOut
pure $ ChangeInput committedTxIn mutatedOutput
]
where
TxOut commitOutputAddress commitOutputValue commitOutputDatum =
fromJust $ getOutputs tx !!? 0
-- NOTE: This filtering will also yield any input added for fees, but we don't
-- have any in our test scenario so far.
comittedTxIns =
filter (not . isInitialOutput . snd) . utxoPairs $ utxo
(committedTxIn, committedTxOut) = healthyCommittedUtxo
committedAddress = txOutAddress committedTxOut
committedOutputValue = txOutValue committedTxOut
)
import qualified Hydra.Contract.Head as Head
import qualified Hydra.Contract.HeadState as Head
import qualified Hydra.Contract.Initial as Initial
import Hydra.Ledger.Cardano (
AlonzoEra,
CardanoTx,
headAddress = Api.mkScriptAddress @Api.PlutusScriptV1 Fixture.testNetworkId headScript
headScript = Api.fromPlutusScript $ Head.validatorScript policyId
isInitialOutput :: TxOut CtxUTxO Era -> Bool
isInitialOutput (TxOut addr _ _) = addr == initialAddress
where
initialAddress = Api.mkScriptAddress @Api.PlutusScriptV1 Fixture.testNetworkId initialScript
initialScript = Api.fromPlutusScript Initial.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.
* I removed an outdated comment * I renamed datum to datum_option (since it can be a hash or a datum)
Other small changes include: * Added a trace event `TDBInitialisingFromLMDBDone`. * Initialisation from an existing LMDB database does not rely on the default `LMDBLimits` anymore, and is passed a limits argument instead. TODO: We should decide whether we want to hardcode these limits to a a substantially large one, or possibly we could link these limits to a versioning number?
add cwbtc
attempt implementation
Other small changes include: * Added a trace event `TDBInitialisingFromLMDBDone`. * Initialisation from an existing LMDB database does not rely on the default `LMDBLimits` anymore, and is passed a limits argument instead. TODO: We should decide whether we want to hardcode these limits to a a substantially large one, or possibly we could link these limits to a versioning number?
Updated crypto exchange rates chapter. I tried my best to address @rdlrt concerns. I would like to add that English is just my 3rd language, so I hope it is not too bad.
Previously, the sequence number of the database is written to disk as part of the on-disk database settings on every flush/write. Conceptually however, the settings of a database should not change on every flush or write. Instead, we make a dinstinction between on-disk database "settings" and "state", where the state can be updated in every write/flush, but the settings should generally be left untouched after database initialisation or node start-up.
Fixes #217.
This works because (a) JavaScript is ultimately single-threaded, (b) there's no execution preemption happening between a 'send' and a 'wait'.