diff --git a/.github/workflows/weeder.yaml b/.github/workflows/weeder.yaml new file mode 100644 index 00000000000..ce3da64afd5 --- /dev/null +++ b/.github/workflows/weeder.yaml @@ -0,0 +1,32 @@ +name: Check code weeds + +on: + # We're using merge-chains; so this needs to run then. + merge_group: + pull_request: + +jobs: + weeder: + name: Check code weeds + runs-on: ubuntu-latest + steps: + - name: 📥 Checkout repository + uses: actions/checkout@v4 + + - name: ❄ Prepare nix + uses: cachix/install-nix-action@v30 + with: + extra_nix_config: | + accept-flake-config = true + log-lines = 1000 + + - name: ❄ Cachix cache of nix derivations + uses: cachix/cachix-action@v15 + with: + name: cardano-scaling + authToken: '${{ secrets.CACHIX_CARDANO_SCALING_AUTH_TOKEN }}' + + - name: 📐 Check weeder + run: | + nix develop .#ci --command -- bash -c "cabal update && cabal build all" + nix develop .#ci --command -- bash -c "weeder --require-hs-files" diff --git a/hydra-cardano-api/hydra-cardano-api.cabal b/hydra-cardano-api/hydra-cardano-api.cabal index 4ea8d2e0929..1d567e4abe5 100644 --- a/hydra-cardano-api/hydra-cardano-api.cabal +++ b/hydra-cardano-api/hydra-cardano-api.cabal @@ -50,7 +50,6 @@ library Hydra.Cardano.Api.CtxUTxO Hydra.Cardano.Api.ExecutionUnits Hydra.Cardano.Api.Hash - Hydra.Cardano.Api.KeyWitness Hydra.Cardano.Api.Network Hydra.Cardano.Api.NetworkId Hydra.Cardano.Api.PlutusScript diff --git a/hydra-cardano-api/src/Cardano/Api/UTxO.hs b/hydra-cardano-api/src/Cardano/Api/UTxO.hs index 47e01c11e5a..08cc50d10f2 100644 --- a/hydra-cardano-api/src/Cardano/Api/UTxO.hs +++ b/hydra-cardano-api/src/Cardano/Api/UTxO.hs @@ -83,20 +83,10 @@ render :: (TxIn, TxOut ctx era) -> Text render (k, TxOut _ (txOutValueToValue -> v) _ _) = T.drop 54 (renderTxIn k) <> " ↦ " <> renderValue v --- | Select the minimum (by TxIn) utxo entry from the UTxO map. --- --- This function is partial. -min :: UTxO -> UTxO -min = UTxO . uncurry Map.singleton . Map.findMin . toMap - -- | Remove the right hand side from the left hand side. difference :: UTxO' out -> UTxO' out -> UTxO' out difference a b = UTxO $ Map.difference (toMap a) (toMap b) --- | Infix version of 'difference'. -(\\) :: UTxO' out -> UTxO' out -> UTxO' out -a \\ b = difference a b - -- * Type Conversions -- | Transforms a UTxO containing tx outs from any era into Babbage era. diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api.hs b/hydra-cardano-api/src/Hydra/Cardano/Api.hs index 3311853452b..f2f3d32e8de 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api.hs @@ -130,7 +130,6 @@ import Hydra.Cardano.Api.CtxTx as Extras import Hydra.Cardano.Api.CtxUTxO as Extras import Hydra.Cardano.Api.ExecutionUnits as Extras import Hydra.Cardano.Api.Hash as Extras -import Hydra.Cardano.Api.KeyWitness as Extras import Hydra.Cardano.Api.NetworkId () import Hydra.Cardano.Api.PlutusScript as Extras import Hydra.Cardano.Api.PolicyId as Extras diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/ExecutionUnits.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/ExecutionUnits.hs index 47da20726f1..a474759f780 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/ExecutionUnits.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/ExecutionUnits.hs @@ -9,7 +9,3 @@ import Cardano.Ledger.Alonzo.Scripts qualified as Ledger -- | Convert a cardano-api 'ExecutionUnits' into a cardano-ledger 'ExUnits' toLedgerExUnits :: ExecutionUnits -> Ledger.ExUnits toLedgerExUnits = toAlonzoExUnits - --- | Convert a cardano-ledger 'ExUnits' into a cardano-api 'ExecutionUnits' -fromLedgerExUnits :: Ledger.ExUnits -> ExecutionUnits -fromLedgerExUnits = fromAlonzoExUnits diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/Hash.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/Hash.hs index d0cf74f01a1..07d9244c388 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/Hash.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/Hash.hs @@ -5,7 +5,6 @@ import Hydra.Cardano.Api.Prelude import Cardano.Ledger.Keys qualified as Ledger import Cardano.Ledger.Plutus.TxInfo (transKeyHash) import Cardano.Ledger.SafeHash (unsafeMakeSafeHash) -import Cardano.Ledger.Shelley.Scripts qualified as Ledger import Data.ByteString qualified as BS import PlutusLedgerApi.V3 qualified as Plutus @@ -33,22 +32,6 @@ unsafePaymentKeyHashFromBytes bytes | otherwise = PaymentKeyHash $ Ledger.KeyHash $ unsafeHashFromBytes bytes --- | Unsafe wrap some bytes as a 'ScriptHash', relying on the fact that Plutus --- is using Blake2b_224 for hashing data (according to 'cardano-ledger'). --- --- Pre-condition: the input bytestring MUST be of length 28. -unsafeScriptHashFromBytes :: - HasCallStack => - ByteString -> - ScriptHash -unsafeScriptHashFromBytes bytes - | BS.length bytes /= 28 = - error $ "unsafeScriptHashFromBytes: pre-condition failed: " <> show (BS.length bytes) <> " bytes." - | otherwise = - fromShelleyScriptHash - . Ledger.ScriptHash - $ unsafeHashFromBytes bytes - -- | Unsafe wrap some bytes as a 'Hash ScriptData', relying on the fact that -- Plutus is using Blake2b_256 for hashing data (according to 'cardano-ledger'). -- diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/KeyWitness.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/KeyWitness.hs deleted file mode 100644 index f97b96a7b10..00000000000 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/KeyWitness.hs +++ /dev/null @@ -1,74 +0,0 @@ -module Hydra.Cardano.Api.KeyWitness where - -import Hydra.Cardano.Api.Prelude - -import Cardano.Ledger.Alonzo.TxWits qualified as Ledger -import Cardano.Ledger.Era qualified as Ledger -import Cardano.Ledger.Keys qualified as Ledger -import Data.Set qualified as Set - --- * Extras - --- | Construct a 'KeyWitness' from a transaction id and credentials. -signWith :: - forall era. - IsShelleyBasedEra era => - TxId -> - SigningKey PaymentKey -> - KeyWitness era -signWith (TxId h) signingKey@(PaymentSigningKey sk) = - let (PaymentVerificationKey vk) = getVerificationKey signingKey - in ShelleyKeyWitness (shelleyBasedEra @era) $ - Ledger.WitVKey - (Ledger.asWitness vk) - (Ledger.signedDSIGN @StandardCrypto sk h) - --- * Type Conversions - --- | Convert a 'List' of cardano-api's 'KeyWitness' into a 'Set' of --- cardano-ledger's 'WitVKey'. --- --- NOTE: 'KeyWitness' is a bigger type than 'WitVKey' witness, this function --- does not only the type conversion but also the selection of the right --- underlying constructors. That means the size of the resulting set may be --- smaller than the size of the list (but never bigger). -toLedgerKeyWitness :: - [KeyWitness era] -> - Set (Ledger.WitVKey 'Ledger.Witness StandardCrypto) -toLedgerKeyWitness vkWits = - Set.fromList [w | ShelleyKeyWitness _ w <- vkWits] - --- | Convert a 'List' of cardano-api's 'KeyWitness' into a 'Set' of --- cardano-ledger's 'BootstrapWitness'. --- --- NOTE: See note on 'toLedgerKeyWitness'. -toLedgerBootstrapWitness :: - [KeyWitness era] -> - Set (Ledger.BootstrapWitness StandardCrypto) -toLedgerBootstrapWitness vkWits = - Set.fromList [w | ShelleyBootstrapWitness _ w <- vkWits] - --- | Convert a cardano-ledger's 'TxWitness' object into a list of cardano-api's --- 'KeyWitness'. --- --- NOTE: this only concerns key and bootstrap witnesses. Scripts and auxiliary --- data are obviously not part of the resulting list. -fromLedgerTxWitness :: - forall era. - ( IsShelleyBasedEra era - , UsesStandardCrypto era - , Ledger.Era (ShelleyLedgerEra era) - ) => - Ledger.AlonzoTxWits (ShelleyLedgerEra era) -> - [KeyWitness era] -fromLedgerTxWitness wits = - mconcat - [ Set.foldr - ((:) . ShelleyKeyWitness shelleyBasedEra) - [] - (Ledger.txwitsVKey' wits) - , Set.foldr - ((:) . ShelleyBootstrapWitness shelleyBasedEra) - [] - (Ledger.txwitsBoot' wits) - ] diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/PlutusScript.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/PlutusScript.hs index 71c2949429e..d5313ddddb0 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/PlutusScript.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/PlutusScript.hs @@ -4,30 +4,12 @@ module Hydra.Cardano.Api.PlutusScript where import Hydra.Cardano.Api.Prelude -import Cardano.Ledger.Alonzo.Scripts qualified as Ledger -import Cardano.Ledger.Plutus.Language qualified as Ledger import Data.ByteString.Short qualified as SBS import PlutusLedgerApi.Common qualified as Plutus import Test.QuickCheck (listOf) -- * Type Conversions --- | Convert a cardano-ledger 'Script' into a cardano-api 'PlutusScript' --- --- NOTE: This function is unsafe in two manners: --- --- (a) If the given script is a timelock script, it throws an impure exception; --- (b) If the given script is in a wrong language, it silently coerces it. -fromLedgerScript :: - ( HasCallStack - , Ledger.AlonzoEraScript era - ) => - Ledger.AlonzoScript era -> - PlutusScript lang -fromLedgerScript = \case - Ledger.TimelockScript{} -> error "fromLedgerScript: TimelockScript" - Ledger.PlutusScript x -> Ledger.withPlutusScript x (\(Ledger.Plutus (Ledger.PlutusBinary bytes)) -> PlutusScriptSerialised bytes) - -- | Convert a serialized plutus script into a cardano-api 'PlutusScript'. fromPlutusScript :: Plutus.SerialisedScript -> PlutusScript lang fromPlutusScript = diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/PolicyId.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/PolicyId.hs index d4a0b8a5088..c39a43f8ed8 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/PolicyId.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/PolicyId.hs @@ -5,7 +5,6 @@ module Hydra.Cardano.Api.PolicyId where import Hydra.Cardano.Api.Prelude import Cardano.Ledger.Alonzo.Plutus.TxInfo qualified as Ledger -import Cardano.Ledger.Hashes qualified as Ledger import Cardano.Ledger.Mary.Value qualified as Ledger import Hydra.Cardano.Api.ScriptHash () import PlutusLedgerApi.V3 (CurrencySymbol, fromBuiltin, unCurrencySymbol) @@ -17,9 +16,6 @@ instance Arbitrary PolicyId where -- * Type conversions -toLedgerScriptHash :: PolicyId -> Ledger.ScriptHash StandardCrypto -toLedgerScriptHash (PolicyId scriptHash) = toShelleyScriptHash scriptHash - -- | Convert Cardano api 'PolicyId' to Cardano ledger `PolicyID`. toLedgerPolicyID :: PolicyId -> Ledger.PolicyID StandardCrypto toLedgerPolicyID (PolicyId sh) = Ledger.PolicyID (toShelleyScriptHash sh) diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/Pretty.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/Pretty.hs index 53cb6ad7ca5..015695a1fc1 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/Pretty.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/Pretty.hs @@ -13,7 +13,7 @@ import Cardano.Ledger.SafeHash qualified as Ledger import Data.Aeson qualified as Aeson import Data.ByteString.Lazy qualified as BL import Data.Function (on) -import Data.List (intercalate, sort, sortBy) +import Data.List (sort, sortBy) import Data.Map.Strict qualified as Map import Data.Text qualified as T import GHC.IsList (IsList (..)) @@ -23,9 +23,6 @@ import Hydra.Cardano.Api.ScriptData (fromLedgerData) renderTx :: Api.Tx -> String renderTx = renderTxWithUTxO mempty -renderTxs :: [Api.Tx] -> String -renderTxs xs = intercalate "\n\n" (renderTx <$> xs) - -- | Like 'renderTx', but uses the given UTxO to resolve inputs. renderTxWithUTxO :: UTxO -> Api.Tx -> String renderTxWithUTxO utxo (Tx body _wits) = diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/ScriptData.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/ScriptData.hs index 653addc62ba..50478c263a2 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/ScriptData.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/ScriptData.hs @@ -4,7 +4,6 @@ module Hydra.Cardano.Api.ScriptData where import Hydra.Cardano.Api.Prelude hiding (left) -import Cardano.Ledger.Alonzo.TxWits qualified as Ledger import Cardano.Ledger.Era qualified as Ledger import Cardano.Ledger.Plutus.Data qualified as Ledger import Codec.Serialise (deserialiseOrFail, serialise) @@ -12,7 +11,6 @@ import Control.Arrow (left) import Data.Aeson (Value (String), withText) import Data.ByteString qualified as BS import Data.ByteString.Base16 qualified as Base16 -import Data.Map qualified as Map import PlutusLedgerApi.V3 qualified as Plutus import Test.QuickCheck (arbitrarySizedNatural, choose, oneof, scale, sized, vector) @@ -36,8 +34,7 @@ fromScriptData = Plutus.fromData . toPlutusData . getScriptData -- | Get the 'HashableScriptData' associated to the a 'TxOut'. Note that this --- requires the 'CtxTx' context. To get script data in a 'CtxUTxO' context, see --- 'lookupScriptData'. +-- requires the 'CtxTx' context. txOutScriptData :: TxOut CtxTx era -> Maybe HashableScriptData txOutScriptData (TxOut _ _ d _) = case d of @@ -45,30 +42,6 @@ txOutScriptData (TxOut _ _ d _) = TxOutDatumInline _ sd -> Just sd _ -> Nothing --- | Lookup included datum of given 'TxOut'. -lookupScriptData :: - forall era. - ( UsesStandardCrypto era - , Ledger.Era (ShelleyLedgerEra era) - ) => - Tx era -> - TxOut CtxUTxO era -> - Maybe HashableScriptData -lookupScriptData (Tx (ShelleyTxBody _ _ _ scriptsData _ _) _) (TxOut _ _ datum _) = - case datum of - TxOutDatumNone -> - Nothing - (TxOutDatumHash _ (ScriptDataHash h)) -> - fromLedgerData <$> Map.lookup h datums - (TxOutDatumInline _ dat) -> - Just dat - where - datums :: Map (Ledger.DataHash StandardCrypto) (Ledger.Data (ShelleyLedgerEra era)) - datums = - case (scriptsData :: TxBodyScriptData era) of - TxBodyNoScriptData -> mempty - TxBodyScriptData _ (Ledger.TxDats m) _ -> m - -- * Type Conversions -- | Convert a cardano-ledger script 'Data' into a cardano-api 'ScriptDatum'. diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/ScriptHash.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/ScriptHash.hs index 2477fb351b4..30dda6bc076 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/ScriptHash.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/ScriptHash.hs @@ -4,19 +4,10 @@ module Hydra.Cardano.Api.ScriptHash where import Hydra.Cardano.Api.Prelude -import Cardano.Ledger.Credential qualified as Ledger import Hydra.Cardano.Api.PlutusScript () -- * Extras --- | Extract the payment part of an address, as a script hash. -getPaymentScriptHash :: AddressInEra era -> Maybe ScriptHash -getPaymentScriptHash = \case - AddressInEra _ (ShelleyAddress _ (Ledger.ScriptHashObj h) _) -> - Just (fromShelleyScriptHash h) - _ -> - Nothing - -- | Like 'hashScript', but for a 'ScriptInAnyLang'. hashScriptInAnyLang :: ScriptInAnyLang -> ScriptHash hashScriptInAnyLang (ScriptInAnyLang _ script) = diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs index 97e233fc813..bc145667b17 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs @@ -10,23 +10,13 @@ where import Hydra.Cardano.Api.Prelude import Cardano.Api.UTxO qualified as UTxO -import Cardano.Ledger.Alonzo.TxWits qualified as Ledger import Cardano.Ledger.Api ( EraTx (mkBasicTx), - bodyTxL, - datsTxWitsL, - getLanguageView, inputsTxBodyL, mkBasicTxBody, - rdmrsTxWitsL, - scriptIntegrityHashTxBodyL, - witsTxL, ) import Cardano.Ledger.Api qualified as Ledger -import Cardano.Ledger.Babbage.Tx (hashScriptIntegrity) -import Cardano.Ledger.Coin (Coin (..)) -import Cardano.Ledger.Plutus.Language qualified as Ledger -import Control.Lens ((&), (.~), (^.)) +import Control.Lens ((&), (.~)) import Data.Bifunctor (bimap) import Data.Functor ((<&>)) import Data.Set qualified as Set @@ -68,12 +58,6 @@ utxoProducedByTx tx = where TxBody body = getTxBody tx --- | Get explicit fees allocated to a transaction. -txFee' :: Tx era -> Coin -txFee' (getTxBody -> TxBody body) = - case txFee body of - TxFeeExplicit _ y -> y - -- * Type Conversions -- | Convert a cardano-api 'Tx' into a matching cardano-ledger 'Tx'. @@ -89,19 +73,3 @@ fromLedgerTx :: Tx era fromLedgerTx = ShelleyTx shelleyBasedEra - --- | Compute the integrity hash of a transaction using a list of plutus languages. -recomputeIntegrityHash :: - (Ledger.AlonzoEraPParams ppera, Ledger.AlonzoEraTxWits txera, Ledger.AlonzoEraTxBody txera, EraTx txera) => - Ledger.PParams ppera -> - [Ledger.Language] -> - Ledger.Tx txera -> - Ledger.Tx txera -recomputeIntegrityHash pp languages tx = do - tx & bodyTxL . scriptIntegrityHashTxBodyL .~ integrityHash - where - integrityHash = - hashScriptIntegrity - (Set.fromList $ getLanguageView pp <$> languages) - (tx ^. witsTxL . rdmrsTxWitsL) - (tx ^. witsTxL . datsTxWitsL) diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/TxBody.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/TxBody.hs index 5e6284fadb0..f05a962e162 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/TxBody.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/TxBody.hs @@ -11,12 +11,8 @@ import Cardano.Ledger.Api ( ) import Cardano.Ledger.Babbage.Core (redeemerPointer) import Cardano.Ledger.BaseTypes (strictMaybeToMaybe) -import Cardano.Ledger.Core qualified as Ledger import Cardano.Ledger.Plutus.Data qualified as Ledger -import Data.List (find) import Data.Map qualified as Map -import Hydra.Cardano.Api.PlutusScript (fromLedgerScript) -import Hydra.Cardano.Api.PolicyId (toLedgerPolicyID, toLedgerScriptHash) import Hydra.Cardano.Api.TxIn (toLedgerTxIn) import PlutusLedgerApi.V3 qualified as Plutus @@ -31,27 +27,6 @@ findRedeemerSpending (getTxBody -> ShelleyTxBody _ body _ scriptData _ _) txIn = ptr <- strictMaybeToMaybe $ redeemerPointer body (ConwaySpending . AsItem $ toLedgerTxIn txIn) lookupRedeemer ptr scriptData -findRedeemerMinting :: - Plutus.FromData a => - Tx Era -> - PolicyId -> - Maybe a -findRedeemerMinting (getTxBody -> ShelleyTxBody _ body _ scriptData _ _) pid = do - ptr <- strictMaybeToMaybe $ redeemerPointer body (ConwayMinting . AsItem $ toLedgerPolicyID pid) - lookupRedeemer ptr scriptData - -findScriptMinting :: - forall lang. - () => - Tx Era -> - PolicyId -> - Maybe (PlutusScript lang) -findScriptMinting (getTxBody -> ShelleyTxBody _ _ scripts _ _ _) pid = do - fromLedgerScript @_ @lang - <$> find ((== needle) . Ledger.hashScript @(ShelleyLedgerEra Era)) scripts - where - needle = toLedgerScriptHash pid - -- -- Internals -- diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/TxId.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/TxId.hs index ab02aa90a9d..2c7f2e478e9 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/TxId.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/TxId.hs @@ -27,8 +27,3 @@ instance FromCBOR TxId where toLedgerTxId :: TxId -> Ledger.TxId StandardCrypto toLedgerTxId (TxId h) = Ledger.TxId (Ledger.unsafeMakeSafeHash (CC.castHash h)) - --- | Convert a cardano-ledger 'TxId' into a cardano-api 'TxId'. -fromLedgerTxId :: Ledger.TxId StandardCrypto -> TxId -fromLedgerTxId (Ledger.TxId h) = - TxId (CC.castHash (Ledger.extractHash h)) diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/TxOutDatum.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/TxOutDatum.hs index e25f16d43a7..506289fea8d 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/TxOutDatum.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/TxOutDatum.hs @@ -4,15 +4,6 @@ import Hydra.Cardano.Api.Prelude import Hydra.Cardano.Api.ScriptData (ToScriptData, toScriptData) --- | Construct a 'TxOutDatum' to be included in the tx from some serialisable data. -mkTxOutDatum :: - forall era a. - (ToScriptData a, IsAlonzoBasedEra era) => - a -> - TxOutDatum CtxTx era -mkTxOutDatum = - TxOutDatumInTx (alonzoBasedEra @era) . toScriptData - -- | Construct a 'TxOutDatum' as a 'ScriptData' hash from some serialisable data. mkTxOutDatumHash :: forall era a ctx. diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/Value.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/Value.hs index af4bc1a2c35..61f7d9031ea 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/Value.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/Value.hs @@ -3,7 +3,6 @@ module Hydra.Cardano.Api.Value where import Hydra.Cardano.Api.Prelude hiding (toLedgerValue) import Cardano.Api.Ledger (Coin (..), PParams) -import Cardano.Ledger.Alonzo.Plutus.TxInfo qualified as Ledger import Cardano.Ledger.Core (getMinCoinTxOut) import Cardano.Ledger.Mary.Value qualified as Ledger import Data.Word (Word64) @@ -92,8 +91,3 @@ fromPlutusValue plutusValue = do toAssetName :: Plutus.TokenName -> AssetName toAssetName = AssetName . fromBuiltin . unTokenName - --- | Convert a cardano-api 'Value' into a plutus 'Value' -toPlutusValue :: Value -> Plutus.Value -toPlutusValue = - Ledger.transValue . toLedgerValue diff --git a/hydra-cluster/bench/Bench/EndToEnd.hs b/hydra-cluster/bench/Bench/EndToEnd.hs index ab98fbd1da8..a4e3318d997 100644 --- a/hydra-cluster/bench/Bench/EndToEnd.hs +++ b/hydra-cluster/bench/Bench/EndToEnd.hs @@ -368,24 +368,6 @@ progressReport nodeId clientId queueSize queue = do threadDelay 5 progressReport nodeId clientId queueSize queue --- --- Helpers --- - -assignUTxO :: (UTxO, Int) -> Map.Map Int (HydraClient, UTxO) -> Map.Map Int (HydraClient, UTxO) -assignUTxO (utxo, clientId) = Map.adjust appendUTxO clientId - where - appendUTxO (client, utxo') = (client, utxo <> utxo') - -noUTxOs :: UTxO -noUTxOs = mempty - -double :: Real a => a -> Double -double = realToFrac - -int :: Int -> Int -int = id - type TransactionId = Integer type TransactionInput = Int type TransactionOutput = Int diff --git a/hydra-cluster/bench/Bench/Options.hs b/hydra-cluster/bench/Bench/Options.hs index ad1b189dcb9..b0995460a92 100644 --- a/hydra-cluster/bench/Bench/Options.hs +++ b/hydra-cluster/bench/Bench/Options.hs @@ -28,7 +28,6 @@ import Options.Applicative ( value, ) import Options.Applicative.Builder (argument) -import Options.Applicative.Help (Doc, align, fillSep, line, (<+>)) data Options = StandaloneOptions @@ -90,9 +89,6 @@ standaloneOptionsParser = <*> timeoutParser <*> startingNodeIdParser -item :: [Doc] -> Doc -item items = line <> ("* " <+> align (fillSep items)) - outputDirectoryParser :: Parser FilePath outputDirectoryParser = strOption diff --git a/hydra-cluster/hydra-cluster.cabal b/hydra-cluster/hydra-cluster.cabal index 5fc922554bd..66d6c9c4f18 100644 --- a/hydra-cluster/hydra-cluster.cabal +++ b/hydra-cluster/hydra-cluster.cabal @@ -90,7 +90,6 @@ library , cardano-slotting , containers , contra-tracer - , data-default , directory , filepath , http-conduit diff --git a/hydra-cluster/src/CardanoNode.hs b/hydra-cluster/src/CardanoNode.hs index 73b4789da76..b975d63378a 100644 --- a/hydra-cluster/src/CardanoNode.hs +++ b/hydra-cluster/src/CardanoNode.hs @@ -15,18 +15,12 @@ import Data.Fixed (Centi) import Data.Text qualified as Text import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) import Hydra.Cardano.Api ( - AsType (AsPaymentKey), File (..), GenesisParameters (..), NetworkId, NetworkMagic (..), - PaymentKey, - SigningKey, SocketPath, - VerificationKey, - generateSigningKey, getProgress, - getVerificationKey, ) import Hydra.Cardano.Api qualified as Api import Hydra.Cluster.Fixture (KnownNetwork (..), toNetworkId) @@ -464,11 +458,6 @@ mkTopology peers = Aeson.object ["addr" .= ("127.0.0.1" :: Text), "port" .= port, "valency" .= (1 :: Int)] -generateCardanoKey :: IO (VerificationKey PaymentKey, SigningKey PaymentKey) -generateCardanoKey = do - sk <- generateSigningKey AsPaymentKey - pure (getVerificationKey sk, sk) - data ProcessHasExited = ProcessHasExited Text ExitCode deriving stock (Show) @@ -503,13 +492,6 @@ cliQueryProtocolParameters nodeSocket networkId = do -- Helpers -- --- | Do something with an a JSON object. Fails if the given JSON value isn't an --- object. -withObject :: (Aeson.Object -> Aeson.Object) -> Aeson.Value -> Aeson.Value -withObject fn = \case - Aeson.Object m -> Aeson.Object (fn m) - x -> x - unsafeDecodeJson :: FromJSON a => ByteString -> IO a unsafeDecodeJson = either fail pure . Aeson.eitherDecodeStrict diff --git a/hydra-cluster/src/Hydra/Cluster/Faucet.hs b/hydra-cluster/src/Hydra/Cluster/Faucet.hs index 843612101bf..82d1699f155 100644 --- a/hydra-cluster/src/Hydra/Cluster/Faucet.hs +++ b/hydra-cluster/src/Hydra/Cluster/Faucet.hs @@ -180,23 +180,6 @@ createOutputAtAddress node@RunningNode{networkId, nodeSocket} atAddress datum va where changeAddress = mkVkAddress networkId --- | Build and sign tx and return the calculated fee. --- - Signing key should be the key of a sender --- - Address is used as a change address. --- - Lovelace amount should be one we are trying to send. -calculateTxFee :: - RunningNode -> - SigningKey PaymentKey -> - UTxO -> - AddressInEra -> - Coin -> - IO Coin -calculateTxFee RunningNode{networkId, nodeSocket} secretKey utxo addr lovelace = - let theOutput = TxOut addr (lovelaceToValue lovelace) TxOutDatumNone ReferenceScriptNone - in buildTransaction networkId nodeSocket addr utxo [] [theOutput] >>= \case - Left e -> throwIO $ FaucetFailedToBuildTx{reason = e} - Right tx -> pure $ txFee' (sign secretKey $ getTxBody tx) - -- | Try to submit tx and retry when some caught exception/s take place. retryOnExceptions :: (MonadCatch m, MonadDelay m) => Tracer m FaucetLog -> m a -> m a retryOnExceptions tracer action = diff --git a/hydra-cluster/src/Hydra/Cluster/Fixture.hs b/hydra-cluster/src/Hydra/Cluster/Fixture.hs index 14774ed4e6c..c8763cd715a 100644 --- a/hydra-cluster/src/Hydra/Cluster/Fixture.hs +++ b/hydra-cluster/src/Hydra/Cluster/Fixture.hs @@ -29,14 +29,6 @@ carolVk = getVerificationKey carolSk cperiod :: ContestationPeriod cperiod = UnsafeContestationPeriod 10 --- | TODO: This is hard-coded and must match what's in the genesis file, so --- ideally, we want to either: --- --- - overwrite the genesis configuration with the `ClusterConfig` --- - pull the network id from the genesis configuration -defaultNetworkId :: NetworkId -defaultNetworkId = Api.Testnet (Api.NetworkMagic 42) - -- NOTE: This is hard-coded and needs to correspond to the initial funds set in -- the genesis-shelley.json file. availableInitialFunds :: Num a => a diff --git a/hydra-cluster/src/Hydra/Generator.hs b/hydra-cluster/src/Hydra/Generator.hs index 0324fb454d3..1fdf71bafb7 100644 --- a/hydra-cluster/src/Hydra/Generator.hs +++ b/hydra-cluster/src/Hydra/Generator.hs @@ -7,7 +7,6 @@ import Cardano.Api.UTxO qualified as UTxO import CardanoClient (QueryPoint (QueryTip), buildTransaction, mkGenesisTx, queryUTxOFor) import Control.Monad (foldM) import Data.Aeson (object, withObject, (.:), (.=)) -import Data.Default (def) import Hydra.Cluster.Faucet (FaucetException (..)) import Hydra.Cluster.Fixture (availableInitialFunds) import Hydra.Ledger.Cardano (mkTransferTx) @@ -87,9 +86,6 @@ instance FromJSON ClientDataset where parseSigningKey = either (fail . show) pure . deserialiseFromTextEnvelope (AsSigningKey AsPaymentKey) -defaultProtocolParameters :: PParams LedgerEra -defaultProtocolParameters = def - -- | Generate a 'Dataset' which does not grow the per-client UTXO set over time. -- This version provided faucet key owns funds on the initial funds of the -- devnet (See 'availableInitialFunds' and 'genesis-shelley.json'). Then for a diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index e3f1d03ed8a..ed71bf79b31 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -10,18 +10,13 @@ import Cardano.Api.UTxO qualified as UTxO import CardanoClient ( QueryPoint (..), RunningNode (..), - queryCurrentEraExpr, - queryEpochNo, queryGenesisParameters, queryTip, queryTipSlotNo, - runQueryExpr, submitTx, waitForUTxO, ) import CardanoNode ( - CardanoNodeArgs (..), - unsafeDecodeJsonFile, withCardanoNodeDevnet, ) import Control.Concurrent.STM (newTVarIO, readTVarIO) @@ -29,7 +24,7 @@ import Control.Concurrent.STM.TVar (modifyTVar') import Control.Lens ((^..), (^?)) import Data.Aeson (Result (..), Value (Null, Object, String), fromJSON, object, (.=)) import Data.Aeson qualified as Aeson -import Data.Aeson.Lens (AsJSON (_JSON), key, values, _Double, _JSON) +import Data.Aeson.Lens (AsJSON (_JSON), key, values, _JSON) import Data.ByteString qualified as BS import Data.List qualified as List import Data.Map qualified as Map @@ -533,27 +528,6 @@ spec = around (showLogsOnFailure "EndToEndSpec") $ do logfile <- readFileBS logFilePath BS.length logfile `shouldSatisfy` (> 0) --- | Query the current era at the tip, and guard that it is equal to the --- provided one. -guardEra :: NetworkId -> SocketPath -> AnyCardanoEra -> IO () -guardEra networkId nodeSocket era = do - runQueryExpr networkId nodeSocket QueryTip queryCurrentEraExpr >>= guard . (== era) - --- | Wait until given number of epoch. This uses the epoch and slot lengths from --- the 'ShelleyGenesisFile' of the node args passed in. -waitUntilEpoch :: FilePath -> CardanoNodeArgs -> RunningNode -> Natural -> IO () -waitUntilEpoch stateDirectory args RunningNode{networkId, nodeSocket} toEpochNo = do - fromEpochNo :: Natural <- fromIntegral . unEpochNo <$> queryEpochNo networkId nodeSocket QueryTip - toEpochNo `shouldSatisfy` (> fromEpochNo) - shelleyGenesisFile :: Aeson.Value <- unsafeDecodeJsonFile (stateDirectory nodeShelleyGenesisFile args) - let slotLength = - fromMaybe (error "Field epochLength not found") $ - shelleyGenesisFile ^? key "slotLength" . _Double - epochLength = - fromMaybe (error "Field epochLength not found") $ - shelleyGenesisFile ^? key "epochLength" . _Double - threadDelay . realToFrac $ fromIntegral (toEpochNo - fromEpochNo) * epochLength * slotLength - waitForLog :: DiffTime -> Handle -> Text -> (Text -> Bool) -> IO () waitForLog delay nodeOutput failureMessage predicate = do seenLogs <- newTVarIO [] @@ -775,9 +749,6 @@ bobCommittedToHead = 5_000_000 paymentFromAliceToBob :: Num a => a paymentFromAliceToBob = 1_000_000 -someTxId :: IsString s => s -someTxId = "9fdc525c20bc00d9dfa9d14904b65e01910c0dfe3bb39865523c1e20eaeb0903" - inHeadAddress :: VerificationKey PaymentKey -> AddressInEra inHeadAddress = mkVkAddress network @@ -788,10 +759,3 @@ inHeadAddress = int :: Int -> Int int = id - -outputRef :: TxId -> Natural -> Value -outputRef tid tix = - object - [ "txId" .= tid - , "index" .= tix - ] diff --git a/hydra-node/src/Hydra/Chain/CardanoClient.hs b/hydra-node/src/Hydra/Chain/CardanoClient.hs index d362c39d673..4f70f6accac 100644 --- a/hydra-node/src/Hydra/Chain/CardanoClient.hs +++ b/hydra-node/src/Hydra/Chain/CardanoClient.hs @@ -28,20 +28,7 @@ data QueryException | QueryProtocolParamsEncodingFailureOnEra AnyCardanoEra Text | QueryEraNotInCardanoModeFailure AnyCardanoEra | QueryNotShelleyBasedEraException AnyCardanoEra - deriving stock (Show) - -instance Eq QueryException where - a == b = case (a, b) of - (QueryAcquireException af1, QueryAcquireException af2) -> case (af1, af2) of - (AFPointTooOld, AFPointTooOld) -> True - (AFPointNotOnChain, AFPointNotOnChain) -> True - _ -> False - (QueryEraMismatchException em1, QueryEraMismatchException em2) -> em1 == em2 - (QueryProtocolParamsEraNotSupported ens1, QueryProtocolParamsEraNotSupported ens2) -> ens1 == ens2 - (QueryProtocolParamsEncodingFailureOnEra e1 f1, QueryProtocolParamsEncodingFailureOnEra e2 f2) -> e1 == e2 && f1 == f2 - (QueryEraNotInCardanoModeFailure e1, QueryEraNotInCardanoModeFailure e2) -> e1 == e2 - (QueryNotShelleyBasedEraException e1, QueryNotShelleyBasedEraException e2) -> e1 == e2 - _ -> False + deriving stock (Show, Eq) instance Exception QueryException where displayException = \case @@ -296,22 +283,6 @@ queryProtocolParameters networkId socket queryPoint = BabbageEra -> encodeToEra BabbageEra pparams ConwayEra -> pure pparams --- | Query the protocol parameters at given point. NOTE: If the era is not --- matching this fails with an era mismatch. --- --- Throws at least 'QueryException' if query fails. -queryProtocolParameters' :: - IsShelleyBasedEra era => - -- | Current network discriminant - NetworkId -> - -- | Filepath to the cardano-node's domain socket - SocketPath -> - QueryPoint -> - IO (PParams (ShelleyLedgerEra era)) -queryProtocolParameters' networkId socket queryPoint = - runQueryExpr networkId socket queryPoint $ - queryInShelleyBasedEraExpr shelleyBasedEra QueryProtocolParameters - -- | Query 'GenesisParameters' at a given point. -- -- Throws at least 'QueryException' if query fails. diff --git a/hydra-node/src/Hydra/Chain/Direct/Tx.hs b/hydra-node/src/Hydra/Chain/Direct/Tx.hs index 981918c045b..86acf3563dc 100644 --- a/hydra-node/src/Hydra/Chain/Direct/Tx.hs +++ b/hydra-node/src/Hydra/Chain/Direct/Tx.hs @@ -18,7 +18,6 @@ import Cardano.Api.UTxO qualified as UTxO import Data.Aeson qualified as Aeson import Data.ByteString qualified as BS import Data.ByteString.Base16 qualified as Base16 -import Data.Map qualified as Map import GHC.IsList (IsList (..)) import Hydra.Contract.Commit qualified as Commit import Hydra.Contract.Deposit qualified as Deposit @@ -48,7 +47,7 @@ import Hydra.Tx.ContestationPeriod (ContestationPeriod, fromChain) import Hydra.Tx.Deposit (DepositObservation (..), observeDepositTx) import Hydra.Tx.OnChainId (OnChainId (..)) import Hydra.Tx.Recover (RecoverObservation (..), observeRecoverTx) -import Hydra.Tx.Utils (assetNameToOnChainId, findFirst, hydraHeadV1AssetName, hydraMetadataLabel) +import Hydra.Tx.Utils (assetNameToOnChainId, findFirst, hydraHeadV1AssetName) import PlutusLedgerApi.V3 (CurrencySymbol, fromBuiltin) import PlutusLedgerApi.V3 qualified as Plutus import Test.Hydra.Tx.Gen () @@ -86,19 +85,6 @@ instance Arbitrary InitialThreadOutput where arbitrary = genericArbitrary shrink = genericShrink --- | Get the metadata entry to identify Hydra transactions (for informational --- purposes). -getHydraHeadV1TxName :: Tx -> Maybe Text -getHydraHeadV1TxName = - lookupName . txMetadata . getTxBodyContent . getTxBody - where - lookupName = \case - TxMetadataNone -> Nothing - TxMetadataInEra (TxMetadata m) -> - case Map.lookup hydraMetadataLabel m of - Just (TxMetaText name) -> Just name - _ -> Nothing - -- * Observe Hydra Head transactions -- | Generalised type for arbitrary Head observations on-chain. diff --git a/hydra-node/src/Hydra/Chain/Direct/Util.hs b/hydra-node/src/Hydra/Chain/Direct/Util.hs index 5572b316cc4..e28c28df6d8 100644 --- a/hydra-node/src/Hydra/Chain/Direct/Util.hs +++ b/hydra-node/src/Hydra/Chain/Direct/Util.hs @@ -27,22 +27,3 @@ readFileTextEnvelopeThrow :: IO a readFileTextEnvelopeThrow asType fileContents = either (fail . show) pure =<< readFileTextEnvelope asType (File fileContents) - -readVerificationKey :: FilePath -> IO (Shelley.VerificationKey PaymentKey) -readVerificationKey = readFileTextEnvelopeThrow (Shelley.AsVerificationKey Shelley.AsPaymentKey) - --- | A simple retrying function with a constant delay. Retries only if the given --- predicate evaluates to 'True'. --- --- Better coupled with a 'timeout' function. -retry :: - forall e m a. - (MonadCatch m, MonadDelay m, Exception e) => - (e -> Bool) -> - m a -> - m a -retry predicate action = - catchIf predicate action $ \_ -> - threadDelay 0.5 >> retry predicate action - where - catchIf f a b = a `catch` \e -> if f e then b e else throwIO e diff --git a/hydra-node/src/Hydra/Chain/Direct/Wallet.hs b/hydra-node/src/Hydra/Chain/Direct/Wallet.hs index b6b3dfc3e7e..541e94f7bca 100644 --- a/hydra-node/src/Hydra/Chain/Direct/Wallet.hs +++ b/hydra-node/src/Hydra/Chain/Direct/Wallet.hs @@ -69,7 +69,7 @@ import Cardano.Ledger.Shelley.API qualified as Ledger import Cardano.Ledger.Val (invert) import Cardano.Slotting.EpochInfo (EpochInfo) import Cardano.Slotting.Time (SystemStart (..)) -import Control.Concurrent.Class.MonadSTM (check, newTVarIO, readTVarIO, writeTVar) +import Control.Concurrent.Class.MonadSTM (newTVarIO, readTVarIO, writeTVar) import Control.Lens (view, (%~), (.~), (^.)) import Data.List qualified as List import Data.Map.Strict ((!)) @@ -144,11 +144,6 @@ data WalletInfoOnChain = WalletInfoOnChain type ChainQuery m = QueryPoint -> Api.Address ShelleyAddr -> m WalletInfoOnChain -watchUTxOUntil :: (Map TxIn TxOut -> Bool) -> TinyWallet IO -> IO (Map TxIn TxOut) -watchUTxOUntil predicate TinyWallet{getUTxO} = atomically $ do - u <- getUTxO - u <$ check (predicate u) - -- | Create a new tiny wallet handle. newTinyWallet :: -- | A tracer for logging diff --git a/hydra-node/src/Hydra/Ledger.hs b/hydra-node/src/Hydra/Ledger.hs index a5c477b8594..5461732af28 100644 --- a/hydra-node/src/Hydra/Ledger.hs +++ b/hydra-node/src/Hydra/Ledger.hs @@ -34,10 +34,6 @@ newtype Ledger tx = Ledger -- necessarily the same as the given UTxO after some transactions } -canApply :: Ledger tx -> ChainSlot -> UTxOType tx -> tx -> ValidationResult -canApply ledger slot utxo tx = - either (Invalid . snd) (const Valid) $ applyTransactions ledger slot utxo (pure tx) - -- | Collect applicable transactions and resulting UTxO. In contrast to -- 'applyTransactions', this functions continues on validation errors. collectTransactions :: Ledger tx -> ChainSlot -> UTxOType tx -> [tx] -> ([tx], UTxOType tx) diff --git a/hydra-node/src/Hydra/Ledger/Simple.hs b/hydra-node/src/Hydra/Ledger/Simple.hs index 0ef8b61d4e8..cfa5b866da2 100644 --- a/hydra-node/src/Hydra/Ledger/Simple.hs +++ b/hydra-node/src/Hydra/Ledger/Simple.hs @@ -136,9 +136,3 @@ utxoRefs = Set.fromList . fmap SimpleTxOut aValidTx :: Integer -> SimpleTx aValidTx n = SimpleTx n mempty (utxoRef n) - --- * Generators - -listOfCommittedUTxOs :: Integer -> Gen [UTxOType SimpleTx] -listOfCommittedUTxOs numCommits = - pure $ Set.singleton . SimpleTxOut <$> [1 .. numCommits] diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index 8aa1f0ca46e..45e59969d20 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -22,7 +22,7 @@ import Hydra.Chain.Direct.State (initialChainState) import Hydra.Chain.Offline (loadGenesisFile, withOfflineChain) import Hydra.Events.FileBased (eventPairFromPersistenceIncremental) import Hydra.Ledger.Cardano (cardanoLedger, newLedgerEnv) -import Hydra.Logging (Verbosity (..), traceWith, withTracer) +import Hydra.Logging (traceWith, withTracer) import Hydra.Logging.Messages (HydraLog (..)) import Hydra.Logging.Monitoring (withMonitoring) import Hydra.Node ( @@ -182,7 +182,3 @@ newGlobals genesisParameters = do -- NOTE: uses fixed epoch info for our L2 ledger epochInfo = fixedEpochInfo protocolParamEpochLength slotLength slotLength = mkSlotLength protocolParamSlotLength - -identifyNode :: RunOptions -> RunOptions -identifyNode opt@RunOptions{verbosity = Verbose "HydraNode", nodeId} = opt{verbosity = Verbose $ "HydraNode-" <> show nodeId} -identifyNode opt = opt diff --git a/hydra-node/test/Hydra/BehaviorSpec.hs b/hydra-node/test/Hydra/BehaviorSpec.hs index c81a39db760..4fa1ce1cf10 100644 --- a/hydra-node/test/Hydra/BehaviorSpec.hs +++ b/hydra-node/test/Hydra/BehaviorSpec.hs @@ -1183,11 +1183,6 @@ openHead chain n1 n2 = do waitUntil [n1, n2] $ Committed testHeadId bob (utxoRef 2) waitUntil [n1, n2] $ HeadIsOpen{headId = testHeadId, utxo = utxoRefs [1, 2]} -matchFanout :: PostChainTx tx -> Bool -matchFanout = \case - FanoutTx{} -> True - _ -> False - assertHeadIsClosed :: (HasCallStack, MonadThrow m) => ServerOutput tx -> m () assertHeadIsClosed = \case HeadIsClosed{} -> pure () diff --git a/hydra-node/test/Hydra/Chain/Direct/HandlersSpec.hs b/hydra-node/test/Hydra/Chain/Direct/HandlersSpec.hs index 6443ba4280e..347d4efa3c8 100644 --- a/hydra-node/test/Hydra/Chain/Direct/HandlersSpec.hs +++ b/hydra-node/test/Hydra/Chain/Direct/HandlersSpec.hs @@ -62,7 +62,6 @@ import Test.QuickCheck ( (===), ) import Test.QuickCheck.Monadic ( - PropertyM, assert, monadicIO, monitor, @@ -256,26 +255,6 @@ recordEventsHandler ctx cs getTimeHandle = do -- 'Block' and can be de-/constructed easily. data TestBlock = TestBlock BlockHeader [Tx] -withCounterExample :: [TestBlock] -> TVar IO ChainStateAt -> IO a -> PropertyM IO a -withCounterExample blocks headState step = do - stBefore <- run $ readTVarIO headState - a <- run step - stAfter <- run $ readTVarIO headState - a <$ do - monitor $ - counterexample $ - toString $ - unlines - [ "Chain state at (before rollback): " <> show stBefore - , "Chain state at (after rollback): " <> show stAfter - , "Block sequence: \n" - <> unlines - ( fmap - (" " <>) - [show (getChainPoint header) | TestBlock header _ <- blocks] - ) - ] - -- | Thin wrapper which generates a 'TestBlock' at some specific slot. genBlockAt :: SlotNo -> [Tx] -> Gen TestBlock genBlockAt sl txs = do @@ -383,11 +362,3 @@ genSequenceOfObservableBlocks = do let commitTx = unsafeCommit ctx headId (getKnownUTxO stInitial) utxo putNextBlock commitTx pure $ snd $ fromJust $ observeCommit ctx stInitial commitTx - -showRollbackInfo :: (Word, ChainPoint) -> String -showRollbackInfo (rollbackDepth, rollbackPoint) = - toString $ - unlines - [ "Rollback depth: " <> show rollbackDepth - , "Rollback point: " <> show rollbackPoint - ] diff --git a/hydra-node/test/Hydra/Chain/Direct/TxTraceSpec.hs b/hydra-node/test/Hydra/Chain/Direct/TxTraceSpec.hs index 621f190fadf..92dbc28e98e 100644 --- a/hydra-node/test/Hydra/Chain/Direct/TxTraceSpec.hs +++ b/hydra-node/test/Hydra/Chain/Direct/TxTraceSpec.hs @@ -227,11 +227,6 @@ latestSnapshotNumber = \case (s : _) -> s.number _ -> 0 -latestSnapshot :: [ModelSnapshot] -> Maybe ModelSnapshot -latestSnapshot = \case - [] -> Nothing - (s : _) -> Just s - -- | Model of a real snapshot which contains a 'SnapshotNumber` but also our -- simplified form of 'UTxO'. data ModelSnapshot = ModelSnapshot @@ -822,8 +817,3 @@ expectInvalid = \case counterexample' $ renderTxWithUTxO spendableUTxO tx fail "But it did not fail" _ -> pure () - --- | Generate sometimes a value with given generator, but more often just use --- the given value. -orSometimes :: a -> Gen a -> Gen a -orSometimes a gen = frequency [(1, pure a), (2, gen)] diff --git a/hydra-node/test/Hydra/Model.hs b/hydra-node/test/Hydra/Model.hs index 5e65d8a5e52..cb7a0221599 100644 --- a/hydra-node/test/Hydra/Model.hs +++ b/hydra-node/test/Hydra/Model.hs @@ -127,11 +127,6 @@ data GlobalState | Final {finalUTxO :: UTxOType Payment} deriving stock (Eq, Show) -isPendingCommitFrom :: Party -> GlobalState -> Bool -isPendingCommitFrom party Initial{pendingCommits} = - party `Map.member` pendingCommits -isPendingCommitFrom _ _ = False - type Uncommitted = Map.Map Party (UTxOType Payment) newtype OffChainState = OffChainState {confirmedUTxO :: UTxOType Payment} diff --git a/hydra-node/test/Hydra/ModelSpec.hs b/hydra-node/test/Hydra/ModelSpec.hs index 7bae4acc4ea..00a2b905c67 100644 --- a/hydra-node/test/Hydra/ModelSpec.hs +++ b/hydra-node/test/Hydra/ModelSpec.hs @@ -114,23 +114,17 @@ import Hydra.Cardano.Api import Hydra.Prelude import Test.Hydra.Prelude hiding (after) -import Cardano.Api.UTxO qualified as UTxO import Control.Concurrent.Class.MonadSTM (newTVarIO) import Control.Monad.Class.MonadTimer () import Control.Monad.IOSim (Failure (FailureException), IOSim, runSimTrace, traceResult) -import Data.Map ((!)) import Data.Map qualified as Map -import Data.Set qualified as Set import GHC.IO (unsafePerformIO) -import Hydra.API.ClientInput (ClientInput (..)) -import Hydra.API.ServerOutput (ServerOutput (..)) -import Hydra.BehaviorSpec (TestHydraClient (..), dummySimulatedChainNetwork) +import Hydra.BehaviorSpec (dummySimulatedChainNetwork) import Hydra.Logging.Messages (HydraLog) import Hydra.Model ( Action (ObserveConfirmedTx, ObserveHeadIsOpen, Wait), GlobalState (..), Nodes (Nodes, nodes), - OffChainState (..), RunMonad, RunState (..), WorldState (..), @@ -145,8 +139,7 @@ import Hydra.Model qualified as Model import Hydra.Model.Payment qualified as Payment import Hydra.Tx.Party (Party (..), deriveParty) import System.IO.Temp (writeSystemTempFile) -import Test.Hydra.Tx.Fixture (testNetworkId) -import Test.QuickCheck (Property, Testable, counterexample, forAllShrink, property, withMaxSuccess, within) +import Test.QuickCheck (Property, Testable, counterexample, property, withMaxSuccess, within) import Test.QuickCheck.DynamicLogic ( DL, Quantification, @@ -160,7 +153,7 @@ import Test.QuickCheck.DynamicLogic ( withGenQ, ) import Test.QuickCheck.Gen.Unsafe (Capture (Capture), capture) -import Test.QuickCheck.Monadic (PropertyM, assert, monadic', monitor, run) +import Test.QuickCheck.Monadic (PropertyM, assert, monadic') import Test.QuickCheck.Property ((===)) import Test.QuickCheck.StateModel ( ActionWithPolarity (..), @@ -313,71 +306,6 @@ prop_doesNotGenerate0AdaUTxO (Actions actions) = _anyOtherStep -> False contains0Ada = (== lovelaceToValue 0) . snd -prop_checkModel :: Property -prop_checkModel = - within 30000000 $ - forAllShrink arbitrary shrink $ \actions -> - runIOSimProp $ do - (metadata, _symEnv) <- runActions actions - let WorldState{hydraParties, hydraState} = underlyingState metadata - -- XXX: This wait time is arbitrary and corresponds to 3 "blocks" from - -- the underlying simulated chain which produces a block every 20s. It - -- should be enough to ensure all nodes' threads terminate their actions - -- and those gets picked up by the chain - run $ lift waitForAMinute - let parties = Set.fromList $ deriveParty . fst <$> hydraParties - nodes <- run $ gets nodes - assert (parties == Map.keysSet nodes) - forM_ parties $ \p -> do - assertBalancesInOpenHeadAreConsistent hydraState nodes p - where - waitForAMinute :: MonadDelay m => m () - waitForAMinute = threadDelay 60 - -assertBalancesInOpenHeadAreConsistent :: - GlobalState -> - Map Party (TestHydraClient Tx (IOSim s)) -> - Party -> - PropertyM (RunMonad (IOSim s)) () -assertBalancesInOpenHeadAreConsistent world nodes p = do - let node = nodes ! p - case world of - Open{offChainState = OffChainState{confirmedUTxO}} -> do - utxo <- run $ getUTxO node - let expectedBalance = - Map.fromListWith - (<>) - [ (unwrapAddress addr, value) - | (Payment.CardanoSigningKey sk, value) <- confirmedUTxO - , let addr = mkVkAddress testNetworkId (getVerificationKey sk) - , valueToLovelace value /= Just 0 - ] - let actualBalance = - Map.fromListWith (<>) $ - [ (unwrapAddress addr, value) - | (TxOut addr value _ _) <- Map.elems (UTxO.toMap utxo) - , valueToLovelace value /= Just 0 - ] - monitor $ - counterexample $ - toString $ - unlines - [ "actualBalance = " <> show actualBalance - , "expectedBalance = " <> show expectedBalance - , "Difference: (" <> show p <> ") " <> show (Map.difference actualBalance expectedBalance) - ] - assert (expectedBalance == actualBalance) - _ -> do - pure () - where - getUTxO node = lift $ do - node `send` GetUTxO - let loop = - waitForNext node >>= \case - GetUTxOResponse _ u -> pure u - _ -> loop - loop - -- -- * Utilities for `IOSim` @@ -444,8 +372,3 @@ eventually a = action_ (Wait 10) >> action_ a action_ :: Action WorldState () -> DL WorldState () action_ = void . action - -unwrapAddress :: AddressInEra -> Text -unwrapAddress = \case - ShelleyAddressInEra addr -> serialiseToBech32 addr - ByronAddressInEra{} -> error "Byron." diff --git a/hydra-node/test/Hydra/NodeSpec.hs b/hydra-node/test/Hydra/NodeSpec.hs index bfc05f60d14..62ce8670797 100644 --- a/hydra-node/test/Hydra/NodeSpec.hs +++ b/hydra-node/test/Hydra/NodeSpec.hs @@ -360,11 +360,6 @@ createPersistenceInMemory = do , loadAll = readTVarIO tvar } -isReqSn :: Message tx -> Bool -isReqSn = \case - ReqSn{} -> True - _ -> False - inputsToOpenHead :: [Input SimpleTx] inputsToOpenHead = [ observationInput $ OnInitTx testHeadId testHeadSeed headParameters participants diff --git a/hydra-node/test/Test/Util.hs b/hydra-node/test/Test/Util.hs index 11938b01ec0..bf0cfcd6423 100644 --- a/hydra-node/test/Test/Util.hs +++ b/hydra-node/test/Test/Util.hs @@ -18,7 +18,6 @@ import Control.Monad.IOSim ( import Control.Tracer (Tracer (Tracer)) import Data.Aeson (encode) import Data.Aeson qualified as Aeson -import Data.List (isInfixOf) import Hydra.Ledger.Simple (SimpleTx) import Hydra.Node (HydraNodeLog) import Test.HUnit.Lang (FailureReason (ExpectedButGot)) @@ -56,28 +55,12 @@ shouldBe actual expected = where reason = ExpectedButGot Nothing (show expected) (show actual) --- | Lifted variant of Hspec's 'shouldReturn'. -shouldReturn :: (HasCallStack, MonadThrow m, Eq a, Show a) => m a -> a -> m () -shouldReturn ma expected = ma >>= (`shouldBe` expected) - --- | Lifted variant of Hspec's 'shouldSatisfy'. -shouldSatisfy :: (HasCallStack, MonadThrow m, Show a) => a -> (a -> Bool) -> m () -shouldSatisfy v p - | p v = pure () - | otherwise = failure $ "predicate failed on: " <> show v - -- | Lifted variant of Hspec's 'shouldNotBe'. shouldNotBe :: (HasCallStack, MonadThrow m, Eq a, Show a) => a -> a -> m () shouldNotBe actual expected | actual /= expected = pure () | otherwise = failure $ "not expected: " <> show actual --- | Lifted variant of Hspec's 'shouldContain'. -shouldContain :: (HasCallStack, MonadThrow m, Eq a, Show a) => [a] -> [a] -> m () -shouldContain actual expected - | expected `isInfixOf` actual = pure () - | otherwise = failure $ show actual <> " does not contain " <> show expected - -- | A 'Tracer' that works in 'IOSim' monad. -- This tracer uses the 'Output' event which uses converts value traced to 'Dynamic' -- which requires 'Typeable' constraint. To retrieve the trace use 'selectTraceEventsDynamic' @@ -115,13 +98,6 @@ isContinuous = \case [_] -> True (a : b : as) -> succ a == b && isContinuous (b : as) --- | Predicate which decides whether given list is monotonic. -isMonotonic :: Ord a => [a] -> Bool -isMonotonic = \case - [] -> True - [_] -> True - (a : b : as) -> a <= b && isMonotonic (b : as) - -- | Predicate which decides whether given list is strictly monotonic. isStrictlyMonotonic :: Ord a => [a] -> Bool isStrictlyMonotonic = \case diff --git a/hydra-plutus/src/Hydra/Contract/Dummy.hs b/hydra-plutus/src/Hydra/Contract/Dummy.hs index 31900509520..11ffca7adae 100644 --- a/hydra-plutus/src/Hydra/Contract/Dummy.hs +++ b/hydra-plutus/src/Hydra/Contract/Dummy.hs @@ -29,5 +29,5 @@ fakeWrap _ _ = toOpaque () dummyValidatorScript :: SerialisedScript dummyValidatorScript = serialiseCompiledCode compiledDummyValidator -dummyValidatorHash :: ScriptHash -dummyValidatorHash = scriptValidatorHash PlutusScriptV3 dummyValidatorScript +validatorHash :: ScriptHash +validatorHash = scriptValidatorHash PlutusScriptV3 dummyValidatorScript diff --git a/hydra-prelude/src/Hydra/Prelude.hs b/hydra-prelude/src/Hydra/Prelude.hs index 456afc48a56..b0e8754af78 100644 --- a/hydra-prelude/src/Hydra/Prelude.hs +++ b/hydra-prelude/src/Hydra/Prelude.hs @@ -32,7 +32,6 @@ module Hydra.Prelude ( shrinkListAggressively, reasonablySized, ReasonablySized (..), - padLeft, padRight, Except, decodeBase16, @@ -215,13 +214,6 @@ newtype ReasonablySized a = ReasonablySized a instance Arbitrary a => Arbitrary (ReasonablySized a) where arbitrary = ReasonablySized <$> reasonablySized arbitrary --- | Pad a text-string to left with the given character until it reaches the given --- length. --- --- NOTE: Truncate the string if longer than the given length. -padLeft :: Char -> Int -> Text -> Text -padLeft c n str = T.takeEnd n (T.replicate n (T.singleton c) <> str) - -- | Pad a text-string to right with the given character until it reaches the given -- length. -- diff --git a/hydra-test-utils/hydra-test-utils.cabal b/hydra-test-utils/hydra-test-utils.cabal index 68e4b43b63d..b8e616813d3 100644 --- a/hydra-test-utils/hydra-test-utils.cabal +++ b/hydra-test-utils/hydra-test-utils.cabal @@ -36,15 +36,9 @@ library Test.Hspec.MarkdownFormatter Test.Hydra.Prelude Test.Network.Ports - Test.Plutus.Validator build-depends: , base - , cardano-ledger-alonzo - , cardano-ledger-core - , cardano-slotting - , containers - , data-default , directory , filepath , hspec @@ -52,12 +46,8 @@ library , hspec-core , hspec-junit-formatter <1.1.1 , HUnit - , hydra-cardano-api , hydra-prelude - , lens , network - , plutus-ledger-api >=1.1.1.0 - , plutus-tx , port-utils , process , QuickCheck @@ -68,7 +58,7 @@ test-suite hydra-test-util-tests import: package-config hs-source-dirs: test other-modules: - HydraTestUtilsSpec + Spec Test.HSpec.MarkdownFormatterSpec main-is: Main.hs diff --git a/hydra-test-utils/src/Test/Hydra/Prelude.hs b/hydra-test-utils/src/Test/Hydra/Prelude.hs index a38ce8fdea7..2b4b8a04d69 100644 --- a/hydra-test-utils/src/Test/Hydra/Prelude.hs +++ b/hydra-test-utils/src/Test/Hydra/Prelude.hs @@ -7,7 +7,6 @@ module Test.Hydra.Prelude ( reasonablySized, ReasonablySized (..), genericCoverTable, - forAll2, pickBlind, module Test.Hspec, module Test.Hspec.QuickCheck, @@ -41,7 +40,7 @@ import Test.Hspec.Api.Formatters.V1 (formatterToFormat, specdoc) import Test.Hspec.Core.Format (Format, FormatConfig (..)) import Test.Hspec.JUnit (defaultJUnitConfig, junitFormat, setJUnitConfigOutputFile) import Test.Hspec.MarkdownFormatter (markdownFormatter) -import Test.QuickCheck (Property, Testable, coverTable, forAll, forAllBlind, tabulate) +import Test.QuickCheck (Property, Testable, coverTable, forAllBlind, tabulate) import Test.QuickCheck.Monadic (PropertyM (MkPropertyM)) -- | Create a unique directory in the caonical, system-specific temporary path, @@ -210,18 +209,6 @@ genericCoverTable xs = enumerate = [minBound .. maxBound] numberOfLabels = toInteger $ length allLabels --- | Shorthand for using 2 generated values in a property. -forAll2 :: - (Testable property, Show a, Show b) => - Gen a -> - Gen b -> - ((a, b) -> property) -> - Property -forAll2 genA genB action = - forAll genA $ \a -> - forAll genB $ \b -> - action (a, b) - -- | Like 'pick' but using 'forAllBlind' under the hood. pickBlind :: Monad m => Gen a -> PropertyM m a pickBlind gen = MkPropertyM $ \k -> do diff --git a/hydra-test-utils/src/Test/Plutus/Validator.hs b/hydra-test-utils/src/Test/Plutus/Validator.hs deleted file mode 100644 index da5bd7e8075..00000000000 --- a/hydra-test-utils/src/Test/Plutus/Validator.hs +++ /dev/null @@ -1,353 +0,0 @@ -{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} - -{-# HLINT ignore "Use <$>" #-} - --- | A helper module mostly wrapping the Alonzo.Tools' --- 'evaluateTransactionExecutionUnits' with a much simpler API (just a plutus --- script). --- --- This is generally handy to measure the execution of Plutus code outside of any --- context (e.g. an implementation of a data-structure on-chain or, as here, --- data encoders). -module Test.Plutus.Validator ( - module Test.Plutus.Validator, - ExecutionUnits (..), -) where - -import Hydra.Prelude - -import Cardano.Api.UTxO qualified as UTxO -import Cardano.Ledger.Alonzo.Core qualified as Ledger -import Cardano.Ledger.Alonzo.Scripts (CostModel, mkCostModel, mkCostModels) -import Cardano.Ledger.BaseTypes (ProtVer (..), natVersion) -import Cardano.Ledger.Plutus.Language (Language (PlutusV2)) -import Cardano.Slotting.EpochInfo (fixedEpochInfo) -import Cardano.Slotting.Slot (EpochSize (EpochSize)) -import Cardano.Slotting.Time (mkSlotLength) -import Control.Lens ((.~)) -import Data.Default (def) -import Data.Map qualified as Map -import Hydra.Cardano.Api ( - BuildTxWith (BuildTxWith), - ExecutionUnits (..), - IsScriptWitnessInCtx (scriptWitnessInCtx), - LedgerEpochInfo (LedgerEpochInfo), - LedgerEra, - LedgerProtocolParameters (LedgerProtocolParameters), - NetworkId (Testnet), - NetworkMagic (NetworkMagic), - PlutusScriptV3, - SystemStart (SystemStart), - ToScriptData, - TxBody, - UTxO, - addTxIn, - cardanoEra, - createAndValidateTransactionBody, - defaultTxBodyContent, - evaluateTransactionExecutionUnits, - fromPlutusScript, - mkScriptAddress, - mkScriptDatum, - mkScriptWitness, - mkTxOutDatumHash, - setTxInsCollateral, - setTxProtocolParams, - toLedgerExUnits, - toScriptData, - pattern ReferenceScriptNone, - pattern ScriptWitness, - pattern TxInsCollateral, - pattern TxOut, - ) -import Hydra.Cardano.Api.Prelude (ScriptExecutionError, ScriptWitnessIndex, TransactionValidityError) -import PlutusLedgerApi.Common (SerialisedScript) -import PlutusTx qualified as Plutus -import Prelude qualified - --- TODO: DRY with Hydra.Ledger.Cardano.Evaluate - -evaluateScriptExecutionUnits :: - Plutus.ToData a => - SerialisedScript -> - a -> - Either Text ExecutionUnits -evaluateScriptExecutionUnits validatorScript redeemer = - case result of - Right (toList -> [units]) -> - first (("unexpected script failure: " <>) . show) units - Right{} -> - Left "executed more than one script?!" - Left e -> - Left ("unexpected failure: " <> show e) - where - result :: - Either - (TransactionValidityError UTxO.Era) - ( Map - ScriptWitnessIndex - ( Either - ScriptExecutionError - ExecutionUnits - ) - ) - result = - (fmap . fmap . fmap) snd $ - evaluateTransactionExecutionUnits - cardanoEra - systemStart - (LedgerEpochInfo epochInfo) - (LedgerProtocolParameters pparams) - (UTxO.toApi utxo) - body - - (body, utxo) = transactionBodyFromScript validatorScript redeemer - - epochInfo = fixedEpochInfo (EpochSize 432000) (mkSlotLength 1) - - systemStart = SystemStart $ Prelude.read "2017-09-23 21:44:51 UTC" - --- | Current (2023-08-04) mainnet parameters. -pparams :: Ledger.PParams LedgerEra -pparams = - def - & Ledger.ppCostModelsL .~ mkCostModels (Map.fromList [(PlutusV2, plutusV2CostModel)]) - & Ledger.ppMaxTxExUnitsL .~ toLedgerExUnits defaultMaxExecutionUnits - & Ledger.ppProtocolVersionL .~ ProtVer{pvMajor = natVersion @8, pvMinor = 0} - --- | Max transaction execution unit budget of the current 'pparams'. -defaultMaxExecutionUnits :: ExecutionUnits -defaultMaxExecutionUnits = - ExecutionUnits - { executionMemory = 14_000_000 - , executionSteps = 10_000_000_000 - } - --- * Generate a transaction body - --- | Create an artifical transaction body which only spends the given script --- with given redeemer and a 'defaultDatum'. -transactionBodyFromScript :: - ToScriptData a => - SerialisedScript -> - a -> - (TxBody, UTxO) -transactionBodyFromScript validatorScript redeemer = - (body, utxo) - where - body = - either (error . show) id $ - createAndValidateTransactionBody $ - defaultTxBodyContent - & addTxIn (defaultTxIn, scriptWitness) - & setTxInsCollateral (TxInsCollateral mempty) - & setTxProtocolParams (BuildTxWith $ Just $ LedgerProtocolParameters pparams) - - utxo = UTxO.singleton (defaultTxIn, txOutFromScript) - - defaultTxIn = arbitrary `generateWith` 42 - - scriptWitness = - BuildTxWith $ - ScriptWitness scriptWitnessInCtx $ - mkScriptWitness script (mkScriptDatum defaultDatum) (toScriptData redeemer) - - script = fromPlutusScript @PlutusScriptV3 validatorScript - - txOutFromScript = - TxOut - (mkScriptAddress @PlutusScriptV3 networkId script) - mempty - (mkTxOutDatumHash defaultDatum) - ReferenceScriptNone - - networkId = Testnet (NetworkMagic 42) - --- | The default datum used in 'transactionBodyFromScript'. -defaultDatum :: () -defaultDatum = () - --- ** Plutus cost model fixtures - --- | Current (2023-08-04) mainnet PlutusV2 cost model. -plutusV2CostModel :: CostModel -plutusV2CostModel = - either (error . show) id $ - mkCostModel - PlutusV2 - [ 205665 - , 812 - , 1 - , 1 - , 1000 - , 571 - , 0 - , 1 - , 1000 - , 24177 - , 4 - , 1 - , 1000 - , 32 - , 117366 - , 10475 - , 4 - , 23000 - , 100 - , 23000 - , 100 - , 23000 - , 100 - , 23000 - , 100 - , 23000 - , 100 - , 23000 - , 100 - , 100 - , 100 - , 23000 - , 100 - , 19537 - , 32 - , 175354 - , 32 - , 46417 - , 4 - , 221973 - , 511 - , 0 - , 1 - , 89141 - , 32 - , 497525 - , 14068 - , 4 - , 2 - , 196500 - , 453240 - , 220 - , 0 - , 1 - , 1 - , 1000 - , 28662 - , 4 - , 2 - , 245000 - , 216773 - , 62 - , 1 - , 1060367 - , 12586 - , 1 - , 208512 - , 421 - , 1 - , 187000 - , 1000 - , 52998 - , 1 - , 80436 - , 32 - , 43249 - , 32 - , 1000 - , 32 - , 80556 - , 1 - , 57667 - , 4 - , 1000 - , 10 - , 197145 - , 156 - , 1 - , 197145 - , 156 - , 1 - , 204924 - , 473 - , 1 - , 208896 - , 511 - , 1 - , 52467 - , 32 - , 64832 - , 32 - , 65493 - , 32 - , 22558 - , 32 - , 16563 - , 32 - , 76511 - , 32 - , 196500 - , 453240 - , 220 - , 0 - , 1 - , 1 - , 69522 - , 11687 - , 0 - , 1 - , 60091 - , 32 - , 196500 - , 453240 - , 220 - , 0 - , 1 - , 1 - , 196500 - , 453240 - , 220 - , 0 - , 1 - , 1 - , 1159724 - , 392670 - , 0 - , 2 - , 806990 - , 30482 - , 4 - , 1927926 - , 82523 - , 4 - , 265318 - , 0 - , 4 - , 0 - , 85931 - , 32 - , 205665 - , 812 - , 1 - , 1 - , 41182 - , 32 - , 212342 - , 32 - , 31220 - , 32 - , 32696 - , 32 - , 43357 - , 32 - , 32247 - , 32 - , 38314 - , 32 - , 35892428 - , 10 - , 57996947 - , 18975 - , 10 - , 38887044 - , 32947 - , 10 - ] diff --git a/hydra-test-utils/test/HydraTestUtilsSpec.hs b/hydra-test-utils/test/HydraTestUtilsSpec.hs deleted file mode 100644 index cef127d9e52..00000000000 --- a/hydra-test-utils/test/HydraTestUtilsSpec.hs +++ /dev/null @@ -1 +0,0 @@ -{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=HydraTestUtilsSpec #-} diff --git a/hydra-test-utils/test/Main.hs b/hydra-test-utils/test/Main.hs index b995e6b5187..973ee182f26 100644 --- a/hydra-test-utils/test/Main.hs +++ b/hydra-test-utils/test/Main.hs @@ -1,9 +1,9 @@ module Main where import Hydra.Prelude -import HydraTestUtilsSpec qualified +import Spec qualified import Test.Hspec.Runner import Test.Hydra.Prelude (combinedHspecFormatter) main :: IO () -main = hspecWith defaultConfig{configFormat = Just (combinedHspecFormatter "hydra-test-utils")} HydraTestUtilsSpec.spec +main = hspecWith defaultConfig{configFormat = Just (combinedHspecFormatter "hydra-test-utils")} Spec.spec diff --git a/hydra-test-utils/test/Spec.hs b/hydra-test-utils/test/Spec.hs new file mode 100644 index 00000000000..5416ef6a866 --- /dev/null +++ b/hydra-test-utils/test/Spec.hs @@ -0,0 +1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-} diff --git a/hydra-tui/src/Hydra/TUI.hs b/hydra-tui/src/Hydra/TUI.hs index 4d32b33e348..aae3e6e1041 100644 --- a/hydra-tui/src/Hydra/TUI.hs +++ b/hydra-tui/src/Hydra/TUI.hs @@ -3,7 +3,7 @@ module Hydra.TUI where -import Hydra.Prelude hiding (Down, State, padLeft) +import Hydra.Prelude hiding (Down, State) import Brick import Hydra.Cardano.Api diff --git a/hydra-tui/src/Hydra/TUI/Drawing.hs b/hydra-tui/src/Hydra/TUI/Drawing.hs index babda36e0ee..1f60ac213f8 100644 --- a/hydra-tui/src/Hydra/TUI/Drawing.hs +++ b/hydra-tui/src/Hydra/TUI/Drawing.hs @@ -5,7 +5,7 @@ module Hydra.TUI.Drawing where -import Hydra.Prelude hiding (Down, State, padLeft) +import Hydra.Prelude hiding (Down, State) import Brick import Hydra.Cardano.Api hiding (Active) diff --git a/hydra-tui/src/Hydra/TUI/Forms.hs b/hydra-tui/src/Hydra/TUI/Forms.hs index 45f9bc631f7..2bea2ed95c5 100644 --- a/hydra-tui/src/Hydra/TUI/Forms.hs +++ b/hydra-tui/src/Hydra/TUI/Forms.hs @@ -5,7 +5,7 @@ module Hydra.TUI.Forms where -import Hydra.Prelude hiding (Down, State, padLeft) +import Hydra.Prelude hiding (Down, State) import Hydra.Cardano.Api diff --git a/hydra-tui/src/Hydra/TUI/Handlers.hs b/hydra-tui/src/Hydra/TUI/Handlers.hs index 74c325d994d..953f059c5da 100644 --- a/hydra-tui/src/Hydra/TUI/Handlers.hs +++ b/hydra-tui/src/Hydra/TUI/Handlers.hs @@ -5,7 +5,7 @@ module Hydra.TUI.Handlers where -import Hydra.Prelude hiding (Down, padLeft) +import Hydra.Prelude hiding (Down) import Brick import Hydra.Cardano.Api hiding (Active) diff --git a/hydra-tui/src/Hydra/TUI/Model.hs b/hydra-tui/src/Hydra/TUI/Model.hs index b0b397a7a41..cd864f1e146 100644 --- a/hydra-tui/src/Hydra/TUI/Model.hs +++ b/hydra-tui/src/Hydra/TUI/Model.hs @@ -4,7 +4,7 @@ module Hydra.TUI.Model where -import Hydra.Prelude hiding (Down, State, padLeft) +import Hydra.Prelude hiding (Down, State) import Hydra.Cardano.Api diff --git a/hydra-tx/hydra-tx.cabal b/hydra-tx/hydra-tx.cabal index f0e842c32c1..7b7d12f9b80 100644 --- a/hydra-tx/hydra-tx.cabal +++ b/hydra-tx/hydra-tx.cabal @@ -88,7 +88,6 @@ library , cborg , containers , data-default - , flat , formatting , hydra-cardano-api , hydra-plutus @@ -97,7 +96,6 @@ library , lens , ouroboros-consensus , ouroboros-consensus-cardano - , plutus-core , plutus-ledger-api , QuickCheck , quickcheck-instances diff --git a/hydra-tx/src/Hydra/Ledger/Cardano/Evaluate.hs b/hydra-tx/src/Hydra/Ledger/Cardano/Evaluate.hs index c695fd13eec..37212761e73 100644 --- a/hydra-tx/src/Hydra/Ledger/Cardano/Evaluate.hs +++ b/hydra-tx/src/Hydra/Ledger/Cardano/Evaluate.hs @@ -17,28 +17,18 @@ module Hydra.Ledger.Cardano.Evaluate where import Hydra.Prelude hiding (label) import Cardano.Api.UTxO qualified as UTxO -import Cardano.Ledger.Alonzo.Plutus.Evaluate (collectPlutusScriptsWithContext) import Cardano.Ledger.Alonzo.Scripts (CostModel, Prices (..), mkCostModel, mkCostModels, txscriptfee) import Cardano.Ledger.Api (CoinPerByte (..), ppCoinsPerUTxOByteL, ppCostModelsL, ppMaxBlockExUnitsL, ppMaxTxExUnitsL, ppMaxValSizeL, ppMinFeeAL, ppMinFeeBL, ppPricesL, ppProtocolVersionL) -import Cardano.Ledger.BaseTypes (BoundedRational (boundRational), ProtVer (..), getVersion, natVersion) +import Cardano.Ledger.BaseTypes (BoundedRational (boundRational), ProtVer (..), natVersion) import Cardano.Ledger.Coin (Coin (Coin)) import Cardano.Ledger.Core (PParams, ppMaxTxSizeL) import Cardano.Ledger.Plutus ( Language (..), - LegacyPlutusArgs (..), - PlutusArgs (..), - PlutusLanguage (decodePlutusRunnable), - PlutusRunnable (..), - PlutusWithContext (..), - SLanguage (..), - isLanguage, - unPlutusV2Args, ) import Cardano.Ledger.Val (Val ((<+>)), (<×>)) import Cardano.Slotting.EpochInfo (EpochInfo, fixedEpochInfo) import Cardano.Slotting.Slot (EpochNo (EpochNo), EpochSize (EpochSize), SlotNo (SlotNo)) import Cardano.Slotting.Time (RelativeTime (RelativeTime), SlotLength, SystemStart (SystemStart), mkSlotLength) -import Control.Arrow (left) import Control.Lens ((.~)) import Control.Lens.Getter import Data.ByteString qualified as BS @@ -48,7 +38,6 @@ import Data.Maybe (fromJust) import Data.Ratio ((%)) import Data.SOP.NonEmpty (NonEmpty (NonEmptyOne)) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) -import Flat (flat) import Hydra.Cardano.Api ( Era, EraHistory (EraHistory), @@ -58,7 +47,7 @@ import Hydra.Cardano.Api ( LedgerEra, LedgerProtocolParameters (..), ProtocolParametersConversionError, - ScriptExecutionError (ScriptErrorMissingScript), + ScriptExecutionError, ScriptWitnessIndex, SerialiseAsCBOR (serialiseToCBOR), StandardCrypto, @@ -68,8 +57,6 @@ import Hydra.Cardano.Api ( evaluateTransactionExecutionUnits, getTxBody, toLedgerExUnits, - toLedgerTx, - toLedgerUTxO, ) import Hydra.Cardano.Api.Pretty (renderTxWithUTxO) import Hydra.Ledger.Cardano.Time (slotNoFromUTCTime, slotNoToUTCTime) @@ -86,13 +73,8 @@ import Ouroboros.Consensus.HardFork.History ( initBound, mkInterpreter, ) -import PlutusCore qualified as PLC -import PlutusLedgerApi.Common (mkTermToEvaluate, toData) -import PlutusLedgerApi.Common qualified as Plutus import Test.QuickCheck (Property, choose, counterexample, property) import Test.QuickCheck.Gen (chooseWord64) -import UntypedPlutusCore (UnrestrictedProgram (..)) -import UntypedPlutusCore qualified as UPLC -- * Evaluate transactions @@ -176,18 +158,6 @@ data EvaluationError type EvaluationReport = (Map ScriptWitnessIndex (Either ScriptExecutionError ExecutionUnits)) -renderEvaluationReportFailures :: EvaluationReport -> Text -renderEvaluationReportFailures reportMap = - unlines $ renderScriptExecutionError <$> failures - where - failures = lefts $ foldMap (: []) reportMap - - renderScriptExecutionError = \case - ScriptErrorMissingScript missingRdmrPtr _ -> - "Missing script of redeemer pointer " <> show missingRdmrPtr - f -> - show f - -- | Get the total used 'ExecutionUnits' from an 'EvaluationReport'. Useful to -- further process the result of 'evaluateTx'. usedExecutionUnits :: EvaluationReport -> ExecutionUnits @@ -223,48 +193,6 @@ estimateMinFee tx evaluationReport = prices = pparams ^. ppPricesL allExunits = foldMap toLedgerExUnits . rights $ toList evaluationReport --- * Profile transactions - --- | Like 'evaluateTx', but instead of actual evaluation, return the --- flat-encoded, fully applied scripts for each redeemer to be evaluated --- externally by 'uplc'. Use input format "flat-namedDeBruijn". This can be used --- to gather profiling information. --- --- NOTE: This assumes we use 'Babbage' and only 'PlutusV2' scripts are used. -prepareTxScripts :: - Tx -> - UTxO -> - Either String [ByteString] -prepareTxScripts tx utxo = do - -- Tuples with scripts and their arguments collected from the tx - results <- - case collectPlutusScriptsWithContext epochInfo systemStart pparams ltx lutxo of - Left e -> Left $ show e - Right x -> pure x - - -- Fully applied UPLC programs which we could run using the cekMachine - programs <- forM results $ \(PlutusWithContext protocolVersion script _ (arguments :: PlutusArgs l) _exUnits _costModel) -> do - (PlutusRunnable rs) <- - case script of - Right runnable -> pure runnable - Left serialised -> left show $ decodePlutusRunnable protocolVersion serialised - -- TODO: replace with mkTermToEvaluate from PlutusLanguage type class once available - let majorProtocolVersion = Plutus.MajorProtocolVersion $ getVersion protocolVersion - args = - case isLanguage @l of - SPlutusV2 -> case unPlutusV2Args arguments of - LegacyPlutusArgs2 redeemer scriptContext -> [redeemer, toData scriptContext] - _ -> error "unexpeted args" - _ -> error "unsupported language" - appliedTerm <- left show $ mkTermToEvaluate Plutus.PlutusV2 majorProtocolVersion rs args - pure $ UPLC.Program () PLC.latestVersion appliedTerm - - pure $ flat . UnrestrictedProgram <$> programs - where - ltx = toLedgerTx tx - - lutxo = toLedgerUTxO utxo - -- * Fixtures -- | Current (2023-04-12) mainchain protocol parameters. @@ -421,12 +349,6 @@ propTransactionFailsEvaluation (tx, lookupUTxO) = -- * Generators -genPointInTime :: Gen (SlotNo, UTCTime) -genPointInTime = do - slot <- SlotNo <$> arbitrary - let time = slotNoToUTCTime systemStart slotLength slot - pure (slot, time) - -- | Parameter here is the contestation period (cp) so we need to generate -- start (tMin) and end (tMax) tx validity bound such that their difference -- is not higher than the cp. @@ -445,12 +367,6 @@ genPointInTimeBefore deadline = do slot <- SlotNo <$> choose (0, slotDeadline) pure (slot, slotNoToUTCTime systemStart slotLength slot) -genPointInTimeAfter :: UTCTime -> Gen (SlotNo, UTCTime) -genPointInTimeAfter deadline = do - let SlotNo slotDeadline = slotNoFromUTCTime systemStart slotLength deadline - slot <- SlotNo <$> choose (slotDeadline, maxBound) - pure (slot, slotNoToUTCTime systemStart slotLength slot) - -- ** Plutus cost model fixtures -- | Current (2024-10-03) mainnet PlutusV3 cost model. diff --git a/hydra-tx/src/Hydra/Tx/Snapshot.hs b/hydra-tx/src/Hydra/Tx/Snapshot.hs index 4f510eba96c..3b174956f94 100644 --- a/hydra-tx/src/Hydra/Tx/Snapshot.hs +++ b/hydra-tx/src/Hydra/Tx/Snapshot.hs @@ -184,13 +184,6 @@ getSnapshot = \case } ConfirmedSnapshot{snapshot} -> snapshot --- | Tell whether a snapshot is the initial snapshot coming from the collect-com --- transaction. -isInitialSnapshot :: ConfirmedSnapshot tx -> Bool -isInitialSnapshot = \case - InitialSnapshot{} -> True - ConfirmedSnapshot{} -> False - instance (Arbitrary tx, Arbitrary (UTxOType tx), IsTx tx) => Arbitrary (ConfirmedSnapshot tx) where arbitrary = do ks <- arbitrary diff --git a/hydra-tx/test/Hydra/Tx/Contract/Close/CloseInitial.hs b/hydra-tx/test/Hydra/Tx/Contract/Close/CloseInitial.hs index 3385867e171..b54e34f6a57 100644 --- a/hydra-tx/test/Hydra/Tx/Contract/Close/CloseInitial.hs +++ b/hydra-tx/test/Hydra/Tx/Contract/Close/CloseInitial.hs @@ -16,7 +16,6 @@ import Hydra.Plutus.Extras (posixFromUTCTime) import Hydra.Plutus.Orphans () import Hydra.Tx ( ConfirmedSnapshot (..), - SnapshotNumber, SnapshotVersion, hashUTxO, mkHeadId, @@ -45,9 +44,6 @@ data CloseInitialMutation = MutateCloseContestationDeadline' deriving stock (Generic, Show, Enum, Bounded) -healthyCloseSnapshotNumber :: SnapshotNumber -healthyCloseSnapshotNumber = 0 - healthyCloseSnapshotVersion :: SnapshotVersion healthyCloseSnapshotVersion = 0 diff --git a/hydra-tx/test/Hydra/Tx/Contract/Increment.hs b/hydra-tx/test/Hydra/Tx/Contract/Increment.hs index 7233e63dd99..3458de22c26 100644 --- a/hydra-tx/test/Hydra/Tx/Contract/Increment.hs +++ b/hydra-tx/test/Hydra/Tx/Contract/Increment.hs @@ -23,7 +23,7 @@ import Hydra.Ledger.Cardano.Time (slotNoFromUTCTime) import Hydra.Plutus.Orphans () import Hydra.Tx.ContestationPeriod (ContestationPeriod, toChain) import Hydra.Tx.Contract.Deposit (depositDeadline, healthyDepositTx) -import Hydra.Tx.Crypto (HydraKey, MultiSignature (..), aggregate, sign) +import Hydra.Tx.Crypto (HydraKey) import Hydra.Tx.HeadId (headIdToCurrencySymbol, mkHeadId) import Hydra.Tx.HeadParameters (HeadParameters (..)) import Hydra.Tx.Increment ( @@ -96,9 +96,6 @@ healthyParties = deriveParty <$> healthySigningKeys healthyOnChainParties :: [OnChain.Party] healthyOnChainParties = partyToChain <$> healthyParties -healthySignature :: MultiSignature (Snapshot Tx) -healthySignature = aggregate [sign sk healthySnapshot | sk <- healthySigningKeys] - healthySnapshotNumber :: SnapshotNumber healthySnapshotNumber = 1 diff --git a/hydra-tx/test/Hydra/Tx/Contract/Recover.hs b/hydra-tx/test/Hydra/Tx/Contract/Recover.hs index c84c2c1c7cc..ef43b240060 100644 --- a/hydra-tx/test/Hydra/Tx/Contract/Recover.hs +++ b/hydra-tx/test/Hydra/Tx/Contract/Recover.hs @@ -17,7 +17,7 @@ import Hydra.Tx.BlueprintTx (CommitBlueprintTx (..)) import Hydra.Tx.Deposit (depositTx) import Hydra.Tx.HeadId (mkHeadId) import Hydra.Tx.Recover (recoverTx) -import PlutusLedgerApi.V3 (CurrencySymbol, POSIXTime) +import PlutusLedgerApi.V3 (CurrencySymbol) import Test.Hydra.Tx.Fixture (testNetworkId, testPolicyId) import Test.Hydra.Tx.Gen (genUTxOAdaOnlyOfSize, genValue) import Test.Hydra.Tx.Mutation ( @@ -42,9 +42,6 @@ healthyRecoverTx = recoverSlotNo :: SlotNo recoverSlotNo = SlotNo $ arbitrary `generateWith` 42 -recoverDeadline :: POSIXTime -recoverDeadline = posixFromUTCTime depositDeadline - depositDeadline :: UTCTime depositDeadline = slotNoToUTCTime systemStart slotLength (recoverSlotNo - SlotNo 1) @@ -69,8 +66,7 @@ depositScriptUTxO :: UTxO depositScriptUTxO = utxoFromTx depositTransaction depositTxIn :: TxIn -depositTxOut :: TxOut CtxUTxO -(depositTxIn, depositTxOut) = List.head $ UTxO.pairs depositScriptUTxO +(depositTxIn, _) = List.head $ UTxO.pairs depositScriptUTxO data RecoverMutation = -- | Move the deposit deadline further so that the recover lower bound is diff --git a/hydra-tx/testlib/Test/Hydra/Tx/Fixture.hs b/hydra-tx/testlib/Test/Hydra/Tx/Fixture.hs index f946493b91c..a827919ed38 100644 --- a/hydra-tx/testlib/Test/Hydra/Tx/Fixture.hs +++ b/hydra-tx/testlib/Test/Hydra/Tx/Fixture.hs @@ -19,7 +19,6 @@ import Cardano.Ledger.Core (PParams, ppMinFeeAL, ppMinFeeBL) import Control.Lens ((.~)) import Data.Maybe (fromJust) import Hydra.Cardano.Api ( - Key (VerificationKey), LedgerEra, NetworkId (Testnet), NetworkMagic (NetworkMagic), @@ -28,7 +27,6 @@ import Hydra.Cardano.Api ( TxIn, deserialiseFromRawBytes, genTxIn, - getVerificationKey, serialiseToRawBytes, verificationKeyHash, ) @@ -55,12 +53,6 @@ bobSk = generateSigningKey "bob" -- NOTE: Using 'zcarol' as seed results in ordered 'deriveParty' values carolSk = generateSigningKey "zcarol" --- | Hydra verification keys for 'alice', 'bob', and 'carol'. -aliceVk, bobVk, carolVk :: VerificationKey HydraKey -aliceVk = getVerificationKey aliceSk -bobVk = getVerificationKey bobSk -carolVk = getVerificationKey carolSk - testHeadId :: HeadId testHeadId = UnsafeHeadId "1234" diff --git a/hydra-tx/testlib/Test/Hydra/Tx/Gen.hs b/hydra-tx/testlib/Test/Hydra/Tx/Gen.hs index 9b0af9a0ed9..1dbc42bae3b 100644 --- a/hydra-tx/testlib/Test/Hydra/Tx/Gen.hs +++ b/hydra-tx/testlib/Test/Hydra/Tx/Gen.hs @@ -282,9 +282,6 @@ shrinkValue :: Value -> [Value] shrinkValue = shrinkMapBy fromList toList shrinkListAggressively -genBytes :: Gen ByteString -genBytes = arbitrary - genHash :: Gen ByteString genHash = BS.pack <$> vector 32 diff --git a/hydra-tx/testlib/Test/Hydra/Tx/Mutation.hs b/hydra-tx/testlib/Test/Hydra/Tx/Mutation.hs index 986614d1052..e9e129b9afe 100644 --- a/hydra-tx/testlib/Test/Hydra/Tx/Mutation.hs +++ b/hydra-tx/testlib/Test/Hydra/Tx/Mutation.hs @@ -160,7 +160,7 @@ import System.Directory.Internal.Prelude qualified as Prelude import Test.Hydra.Prelude import Test.Hydra.Tx.Fixture (testPolicyId) import Test.Hydra.Tx.Fixture qualified as Fixture -import Test.Hydra.Tx.Gen (genKeyPair, genOutput) +import Test.Hydra.Tx.Gen () import Test.QuickCheck ( Property, checkCoverage, @@ -689,16 +689,6 @@ alterTxOuts fn tx = 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 - --- | Finds the Head script's input in given `UTxO` set. --- '''NOTE''': This function is partial, it assumes the `UTxO` set contains a --- Head script output. -headTxIn :: UTxO -> TxIn -headTxIn = fst . Prelude.head . filter (isHeadOutput . snd) . UTxO.pairs - -- | A 'Mutation' that changes the minted/burnt quantity of all tokens to a -- non-zero value different than the given one. changeMintedValueQuantityFrom :: Tx -> Integer -> Gen Mutation diff --git a/nix/hydra/shell.nix b/nix/hydra/shell.nix index 748ca12e882..7bac1e44d43 100644 --- a/nix/hydra/shell.nix +++ b/nix/hydra/shell.nix @@ -147,6 +147,7 @@ let # Note: jq 1.6 has a bug that means it fails to read large integers # correctly, so we require 1.7+ at least. pkgsLatest.jq + pkgs.weeder ]; }; diff --git a/weeder.toml b/weeder.toml index 4395dbd0fe6..75709b4eb11 100644 --- a/weeder.toml +++ b/weeder.toml @@ -1,2 +1,14 @@ -roots = [ "^Main.main$" ,"^Spec.main$" ] +roots = [ "^Main.main$" + , "^Spec.main$" + , "^main$" + , "validatorHash$" + , "validatorScript$" + , "queryEpochNo$" + , "queryUTxOWhole$" + , "traceDebug$" + , "spy$" + , "spy'$" + , "showFromAction$" + , "redeemer$" + ] type-class-roots = true