From 7ac4f6fe11ae32edc5d5894077fedcd552e180b8 Mon Sep 17 00:00:00 2001 From: Mikhail Lazarev Date: Tue, 16 Aug 2022 15:53:27 +0300 Subject: [PATCH 1/4] fix breaking changes --- bot-plutus-interface.cabal | 1 + flake.lock | 76 +++++++++---------- flake.nix | 22 +++--- src/BotPlutusInterface/Balance.hs | 13 ++-- src/BotPlutusInterface/CardanoCLI.hs | 24 +++--- src/BotPlutusInterface/Contract.hs | 13 ++-- src/BotPlutusInterface/Files.hs | 9 ++- src/BotPlutusInterface/TimeSlot.hs | 11 +-- src/BotPlutusInterface/UtxoParser.hs | 28 ++++++- test/Spec.hs | 6 +- .../BotPlutusInterface/AdjustUnbalanced.hs | 2 +- test/Spec/BotPlutusInterface/Balance.hs | 6 +- test/Spec/BotPlutusInterface/Collateral.hs | 8 +- test/Spec/BotPlutusInterface/Contract.hs | 51 +++++++------ test/Spec/BotPlutusInterface/ContractStats.hs | 4 +- .../Spec/BotPlutusInterface/TxStatusChange.hs | 2 +- test/Spec/BotPlutusInterface/UtxoParser.hs | 16 ++-- test/Spec/MockContract.hs | 30 +++++--- 18 files changed, 185 insertions(+), 137 deletions(-) diff --git a/bot-plutus-interface.cabal b/bot-plutus-interface.cabal index fbdf887a..8919179f 100644 --- a/bot-plutus-interface.cabal +++ b/bot-plutus-interface.cabal @@ -109,6 +109,7 @@ library , cardano-api , cardano-crypto , cardano-ledger-alonzo + , cardano-ledger-babbage , cardano-ledger-core , cardano-ledger-shelley , cardano-prelude diff --git a/flake.lock b/flake.lock index 1a16c280..7f0a6e02 100644 --- a/flake.lock +++ b/flake.lock @@ -87,17 +87,17 @@ "cardano-addresses": { "flake": false, "locked": { - "lastModified": 1655809189, - "narHash": "sha256-hYAvI7KlFnFRjMG8/JvDl733YnQUE1O26VMcr94h0oM=", + "lastModified": 1660105670, + "narHash": "sha256-91F9+ckA3lBCE4dAVLDnMSpwRLa7zRUEEBYEHv0sOYk=", "owner": "input-output-hk", "repo": "cardano-addresses", - "rev": "b6f2f3cef01a399376064194fd96711a5bdba4a7", + "rev": "b7273a5d3c21f1a003595ebf1e1f79c28cd72513", "type": "github" }, "original": { "owner": "input-output-hk", "repo": "cardano-addresses", - "rev": "b6f2f3cef01a399376064194fd96711a5bdba4a7", + "rev": "b7273a5d3c21f1a003595ebf1e1f79c28cd72513", "type": "github" } }, @@ -155,34 +155,34 @@ "cardano-ledger": { "flake": false, "locked": { - "lastModified": 1657127204, - "narHash": "sha256-4wcSA61TwoDTvJ6rx7tjEAJjQLO/cs8WGTHcOghNdTc=", + "lastModified": 1659038626, + "narHash": "sha256-zTQbMOGPD1Oodv6VUsfF6NUiXkbN8SWI98W3Atv4wbI=", "owner": "input-output-hk", "repo": "cardano-ledger", - "rev": "3be8a19083fc13d9261b1640e27dd389b51bb08e", + "rev": "c7c63dabdb215ebdaed8b63274965966f2bf408f", "type": "github" }, "original": { "owner": "input-output-hk", "repo": "cardano-ledger", - "rev": "3be8a19083fc13d9261b1640e27dd389b51bb08e", + "rev": "c7c63dabdb215ebdaed8b63274965966f2bf408f", "type": "github" } }, "cardano-node": { "flake": false, "locked": { - "lastModified": 1657227628, - "narHash": "sha256-CP58qcHZJGYq1FzXCj8ll085TvnJoYMeXnVGVGLYH/w=", + "lastModified": 1659625017, + "narHash": "sha256-4IrheFeoWfvkZQndEk4fGUkOiOjcVhcyXZ6IqmvkDgg=", "owner": "input-output-hk", "repo": "cardano-node", - "rev": "c75451f0ffd7a60b5ad6c4263891e6c8acac105a", + "rev": "950c4e222086fed5ca53564e642434ce9307b0b9", "type": "github" }, "original": { "owner": "input-output-hk", + "ref": "1.35.3-rc1", "repo": "cardano-node", - "rev": "c75451f0ffd7a60b5ad6c4263891e6c8acac105a", "type": "github" } }, @@ -222,17 +222,17 @@ "cardano-wallet": { "flake": false, "locked": { - "lastModified": 1657745277, - "narHash": "sha256-+PrfQH6m7ROpHKNyo54MzLrL31tIvSZUQYnbBT70ekc=", + "lastModified": 1660141505, + "narHash": "sha256-3Rnj/g3KLzOW5YSieqsUa9IF1Td22Eskk5KuVsOFgEQ=", "owner": "input-output-hk", "repo": "cardano-wallet", - "rev": "2ac308b00d9d4a3435f6b9594ded9495e2b217eb", + "rev": "18a931648550246695c790578d4a55ee2f10463e", "type": "github" }, "original": { "owner": "input-output-hk", "repo": "cardano-wallet", - "rev": "2ac308b00d9d4a3435f6b9594ded9495e2b217eb", + "rev": "18a931648550246695c790578d4a55ee2f10463e", "type": "github" } }, @@ -409,17 +409,17 @@ "hedgehog-extras": { "flake": false, "locked": { - "lastModified": 1647260073, - "narHash": "sha256-TR9i1J3HUYz3QnFQbfJPr/kGDahxZPojDsorYtRZeGU=", + "lastModified": 1656051321, + "narHash": "sha256-6KQFEzb9g2a0soVvwLKESEbA+a8ygpROcMr6bkatROE=", "owner": "input-output-hk", "repo": "hedgehog-extras", - "rev": "967d79533c21e33387d0227a5f6cc185203fe658", + "rev": "714ee03a5a786a05fc57ac5d2f1c2edce4660d85", "type": "github" }, "original": { "owner": "input-output-hk", "repo": "hedgehog-extras", - "rev": "967d79533c21e33387d0227a5f6cc185203fe658", + "rev": "714ee03a5a786a05fc57ac5d2f1c2edce4660d85", "type": "github" } }, @@ -442,17 +442,17 @@ "hw-aeson": { "flake": false, "locked": { - "lastModified": 1649341404, - "narHash": "sha256-xO4/zPMBmZtBXFwHF8p3nw4TilrJHxH54mfg9CRnuO8=", + "lastModified": 1660113261, + "narHash": "sha256-v0SyVxeVBTtW1tuej4P+Kf4roO/rr2tBI7RthTlInbc=", "owner": "haskell-works", "repo": "hw-aeson", - "rev": "d99d2f3e39a287607418ae605b132a3deb2b753f", + "rev": "b5ef03a7d7443fcd6217ed88c335f0c411a05408", "type": "github" }, "original": { "owner": "haskell-works", "repo": "hw-aeson", - "rev": "d99d2f3e39a287607418ae605b132a3deb2b753f", + "rev": "b5ef03a7d7443fcd6217ed88c335f0c411a05408", "type": "github" } }, @@ -730,51 +730,51 @@ "ouroboros-network": { "flake": false, "locked": { - "lastModified": 1654820431, - "narHash": "sha256-bmLD5sFsiny/eRv6MHrqGvo6I4QG9pO0psiHWGFZqro=", + "lastModified": 1658339771, + "narHash": "sha256-3ElbHM1B5u1QD0aes1KbaX2FxKJzU05H0OzJ36em1Bg=", "owner": "input-output-hk", "repo": "ouroboros-network", - "rev": "a65c29b6a85e90d430c7f58d362b7eb097fd4949", + "rev": "cb9eba406ceb2df338d8384b35c8addfe2067201", "type": "github" }, "original": { "owner": "input-output-hk", "repo": "ouroboros-network", - "rev": "a65c29b6a85e90d430c7f58d362b7eb097fd4949", + "rev": "cb9eba406ceb2df338d8384b35c8addfe2067201", "type": "github" } }, "plutus": { "flake": false, "locked": { - "lastModified": 1656585904, - "narHash": "sha256-ATwDR5LX2RN9YfoPhTxV7REvFoJnM4x/CN9XZVZlalg=", + "lastModified": 1659046871, + "narHash": "sha256-coD/Kpl7tutwXb6ukQCH5XojBjquYkW7ob0BWZtdpok=", "owner": "input-output-hk", "repo": "plutus", - "rev": "69ab98c384703172f898eb5bcad1078ded521426", + "rev": "a56c96598b4b25c9e28215214d25189331087244", "type": "github" }, "original": { "owner": "input-output-hk", "repo": "plutus", - "rev": "69ab98c384703172f898eb5bcad1078ded521426", + "rev": "a56c96598b4b25c9e28215214d25189331087244", "type": "github" } }, "plutus-apps": { "flake": false, "locked": { - "lastModified": 1658828135, - "narHash": "sha256-4Fxt5QLTopthYbxc0dvW3/6nw8Zn0qcYGG6ZzSKiqSQ=", - "owner": "mlabs-haskell", + "lastModified": 1660652339, + "narHash": "sha256-0lCjJWMHYCFW62B5QAmkPakqNWdj2hJBqQP4AWHjBFE=", + "owner": "mikekeke", "repo": "plutus-apps", - "rev": "5cd1682b1ccf8f12c64fc0c1731d61fee41779f6", + "rev": "efdb04b602ade22245769f7e52d07475b3e8c339", "type": "github" }, "original": { - "owner": "mlabs-haskell", + "owner": "mikekeke", "repo": "plutus-apps", - "rev": "5cd1682b1ccf8f12c64fc0c1731d61fee41779f6", + "rev": "efdb04b602ade22245769f7e52d07475b3e8c339", "type": "github" } }, diff --git a/flake.nix b/flake.nix index 16f8e7e9..370428b4 100644 --- a/flake.nix +++ b/flake.nix @@ -17,7 +17,7 @@ # all inputs below here are for pinning with haskell.nix cardano-addresses = { url = - "github:input-output-hk/cardano-addresses/b6f2f3cef01a399376064194fd96711a5bdba4a7"; + "github:input-output-hk/cardano-addresses/b7273a5d3c21f1a003595ebf1e1f79c28cd72513"; flake = false; }; cardano-base = { @@ -37,12 +37,12 @@ }; cardano-ledger = { url = - "github:input-output-hk/cardano-ledger/3be8a19083fc13d9261b1640e27dd389b51bb08e"; + "github:input-output-hk/cardano-ledger/c7c63dabdb215ebdaed8b63274965966f2bf408f"; flake = false; }; cardano-node = { url = - "github:input-output-hk/cardano-node/c75451f0ffd7a60b5ad6c4263891e6c8acac105a"; + "github:input-output-hk/cardano-node?ref=1.35.3-rc1"; flake = false; # we need it to be available in shell }; cardano-prelude = { @@ -51,7 +51,7 @@ flake = false; }; cardano-wallet = { - url = "github:input-output-hk/cardano-wallet/2ac308b00d9d4a3435f6b9594ded9495e2b217eb"; + url = "github:input-output-hk/cardano-wallet/18a931648550246695c790578d4a55ee2f10463e"; flake = false; }; ekg-forward = { @@ -74,7 +74,7 @@ flake = false; }; hedgehog-extras = { - url = "github:input-output-hk/hedgehog-extras/967d79533c21e33387d0227a5f6cc185203fe658"; + url = "github:input-output-hk/hedgehog-extras/714ee03a5a786a05fc57ac5d2f1c2edce4660d85"; flake = false; }; hysterical-screams = { @@ -82,7 +82,7 @@ flake = false; }; hw-aeson = { - url = "github:haskell-works/hw-aeson/d99d2f3e39a287607418ae605b132a3deb2b753f"; + url = "github:haskell-works/hw-aeson/b5ef03a7d7443fcd6217ed88c335f0c411a05408"; flake = false; }; iohk-monitoring-framework = { @@ -102,17 +102,18 @@ }; ouroboros-network = { url = - "github:input-output-hk/ouroboros-network/a65c29b6a85e90d430c7f58d362b7eb097fd4949"; + "github:input-output-hk/ouroboros-network/cb9eba406ceb2df338d8384b35c8addfe2067201"; flake = false; }; plutus = { url = - "github:input-output-hk/plutus/69ab98c384703172f898eb5bcad1078ded521426"; + "github:input-output-hk/plutus/a56c96598b4b25c9e28215214d25189331087244"; flake = false; }; plutus-apps = { url = - "github:mlabs-haskell/plutus-apps/5cd1682b1ccf8f12c64fc0c1731d61fee41779f6"; + "github:mikekeke/plutus-apps/efdb04b602ade22245769f7e52d07475b3e8c339"; + # "git+file:///home/mike/dev/iog/plutus-apps-bpi-debug?rev=7ab52429bfe1b88dd46c72727b40f871d3fb8d63"; flake = false; }; purescript-bridge = { @@ -358,6 +359,7 @@ "playground-common" "plutus-chain-index" "plutus-chain-index-core" + "plutus-hysterical-screams" "plutus-contract" "plutus-contract-certification" "plutus-ledger" @@ -411,7 +413,7 @@ additional = ps: [ ps.plutus-pab ]; - withHoogle = false; + withHoogle = true; tools.haskell-language-server = { }; exactDeps = true; nativeBuildInputs = with pkgs'; [ diff --git a/src/BotPlutusInterface/Balance.hs b/src/BotPlutusInterface/Balance.hs index 447df0bb..5d0a4c32 100644 --- a/src/BotPlutusInterface/Balance.hs +++ b/src/BotPlutusInterface/Balance.hs @@ -280,7 +280,7 @@ balanceTxStep balanceCfg utxos changeAddr tx = getChange :: Map TxOutRef TxOut -> Tx -> Value getChange utxos tx = let fees = lovelaceValue $ txFee tx - txInRefs = map Tx.txInRef $ Set.toList $ txInputs tx + txInRefs = map Tx.txInRef $ txInputs tx inputValue = mconcat $ map Tx.txOutValue $ mapMaybe (`Map.lookup` utxos) txInRefs outputValue = mconcat $ map Tx.txOutValue $ txOutputs tx nonMintedOutputValue = outputValue `minus` txMint tx @@ -311,13 +311,16 @@ balanceTxIns utxos tx = do [ txFee tx , nonMintedValue ] - txIns <- newEitherT $ selectTxIns @w (txInputs tx) utxos minSpending - pure $ tx {txInputs = txIns <> txInputs tx} + txIns <- newEitherT $ selectTxIns @w (Set.fromList $ txInputs tx) utxos minSpending + -- FIXME: maybe better way to handle to <> from Set, as now using list here will break balancing + -- constantly adding inputs and running balance loop forever + pure $ tx {txInputs = Set.toList (txIns <> Set.fromList (txInputs tx))} + -- | Set collateral or fail in case it's required but not available addTxCollaterals :: CollateralUtxo -> Tx -> Tx addTxCollaterals cOut tx - | txUsesScripts tx = tx {txCollateral = Set.singleton (Tx.pubKeyTxIn (collateralTxOutRef cOut))} + | txUsesScripts tx = tx {txCollateral = [Tx.pubKeyTxIn (collateralTxOutRef cOut)]} | otherwise = tx txUsesScripts :: Tx -> Bool @@ -325,7 +328,7 @@ txUsesScripts Tx {txInputs, txMintScripts} = not (null txMintScripts) || any (\TxIn {txInType} -> case txInType of Just ConsumeScriptAddress {} -> True; _ -> False) - (Set.toList txInputs) + txInputs -- | Ensures all non ada change goes back to user handleNonAdaChange :: BalanceConfig -> Address -> Map TxOutRef TxOut -> Tx -> Either Text Tx diff --git a/src/BotPlutusInterface/CardanoCLI.hs b/src/BotPlutusInterface/CardanoCLI.hs index 2abac2ba..1e07fd66 100644 --- a/src/BotPlutusInterface/CardanoCLI.hs +++ b/src/BotPlutusInterface/CardanoCLI.hs @@ -52,12 +52,10 @@ import Data.List (sort) import Data.Map (Map) import Data.Map qualified as Map import Data.Maybe (fromMaybe) -import Data.Set (Set) -import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as Text import Data.Text.Encoding (decodeUtf8) -import Ledger (Slot (Slot), SlotRange) +import Ledger (MintingPolicy, MintingPolicyHash, Slot (Slot), SlotRange) -- FIXME" consider qualified imports as before import Ledger qualified import Ledger.Ada (fromValue, getLovelace) import Ledger.Ada qualified as Ada @@ -75,6 +73,7 @@ import Ledger.Tx (ChainIndexTxOut, RedeemerPtr (..), Redeemers, ScriptTag (..), import Ledger.Tx.CardanoAPI (toCardanoAddressInEra) import Ledger.Value (Value) import Ledger.Value qualified as Value +import Plutus.Script.Utils.Scripts qualified as Scripts import Plutus.V1.Ledger.Api ( CurrencySymbol (..), ExBudget (..), @@ -236,7 +235,7 @@ submitTx pabConf tx = ) (const ()) -txInOpts :: SpendBudgets -> PABConfig -> Set TxIn -> ([Text], ExBudget) +txInOpts :: SpendBudgets -> PABConfig -> [TxIn] -> ([Text], ExBudget) txInOpts spendIndex pabConf = foldMap ( \(TxIn txOutRef txInType) -> @@ -250,12 +249,11 @@ txInOpts spendIndex pabConf = , opts ] ) - . Set.toList where scriptInputs :: Maybe TxInType -> ExBudget -> ([Text], ExBudget) scriptInputs txInType exBudget = case txInType of - Just (ConsumeScriptAddress validator redeemer datum) -> + Just (ConsumeScriptAddress _lang validator redeemer datum) -> (,exBudget) $ mconcat [ @@ -279,12 +277,18 @@ txInOpts spendIndex pabConf = Just ConsumeSimpleScriptAddress -> mempty Nothing -> mempty -txInCollateralOpts :: Set TxIn -> [Text] +txInCollateralOpts :: [TxIn] -> [Text] txInCollateralOpts = - concatMap (\(TxIn txOutRef _) -> ["--tx-in-collateral", txOutRefToCliArg txOutRef]) . Set.toList + concatMap (\(TxIn txOutRef _) -> ["--tx-in-collateral", txOutRefToCliArg txOutRef]) -- Minting options -mintOpts :: MintBudgets -> PABConfig -> Set Scripts.MintingPolicy -> Redeemers -> Value -> ([Text], ExBudget) +mintOpts :: + MintBudgets -> + PABConfig -> + Map MintingPolicyHash MintingPolicy -> + Redeemers -> + Value -> + ([Text], ExBudget) mintOpts mintIndex pabConf mintingPolicies redeemers mintValue = let scriptOpts = foldMap @@ -306,7 +310,7 @@ mintOpts mintIndex pabConf mintingPolicies redeemers mintValue = ] in orMempty $ fmap toOpts redeemer ) - $ zip [0 ..] $ Set.toList mintingPolicies + $ zip [0 ..] $ Map.elems mintingPolicies mintOpt = if not (Value.isZero mintValue) then ["--mint", valueToCliArg mintValue] diff --git a/src/BotPlutusInterface/Contract.hs b/src/BotPlutusInterface/Contract.hs index f6841504..799a764c 100644 --- a/src/BotPlutusInterface/Contract.hs +++ b/src/BotPlutusInterface/Contract.hs @@ -85,7 +85,7 @@ import Ledger.Tx qualified as Tx import Ledger.Validation (Coin (Coin)) import Plutus.ChainIndex.TxIdState (fromTx, transactionStatus) import Plutus.ChainIndex.Types (RollbackState (..), TxIdState, TxStatus) -import Plutus.Contract.CardanoAPI (toCardanoTxOutBabbage, toCardanoTxOutDatumHashBabbage) +-- import Plutus.Contract.CardanoAPI (toCardanoTxOutBabbage, toCardanoTxOutDatumHashBabbage) import Plutus.Contract.Checkpoint (Checkpoint (..)) import Plutus.Contract.Effects ( BalanceTxResponse (..), @@ -103,6 +103,7 @@ import Prettyprinter (Pretty (pretty), (<+>)) import Prettyprinter qualified as PP import Wallet.Emulator.Error (WalletAPIError (..)) import Prelude +import Ledger.Tx.CardanoAPI (toCardanoTxOut, toCardanoTxOutDatumHash) runContract :: forall (w :: Type) (s :: Row Type) (e :: Type) (a :: Type). @@ -213,7 +214,7 @@ handlePABReq contractEnv req = do WriteBalancedTxResp <$> writeBalancedTx @w contractEnv tx' AwaitSlotReq s -> AwaitSlotResp <$> awaitSlot @w contractEnv s AwaitTimeReq t -> AwaitTimeResp <$> awaitTime @w contractEnv t - CurrentSlotReq -> CurrentSlotResp <$> currentSlot @w contractEnv + CurrentPABSlotReq -> CurrentPABSlotResp <$> currentSlot @w contractEnv CurrentTimeReq -> CurrentTimeResp <$> currentTime @w contractEnv PosixTimeRangeToContainedSlotRangeReq posixTimeRange -> either (error . show) (PosixTimeRangeToContainedSlotRangeResp . Right) @@ -228,6 +229,8 @@ handlePABReq contractEnv req = do AwaitTxOutStatusChangeReq _ -> error ("Unsupported PAB effect: " ++ show req) ExposeEndpointReq _ -> error ("Unsupported PAB effect: " ++ show req) YieldUnbalancedTxReq _ -> error ("Unsupported PAB effect: " ++ show req) + CurrentChainIndexSlotReq -> error ("Unsupported PAB effect: " ++ show req) + printBpiLog @w (Debug [PABLog]) $ pretty resp pure resp @@ -267,7 +270,7 @@ adjustUnbalancedTx' contractEnv unbalancedTx = pure $ do <$> contractEnv.cePABConfig.pcProtocolParams adjustTxOut networkId pparams txOut = do - txOut' <- toCardanoTxOutBabbage networkId toCardanoTxOutDatumHashBabbage txOut + txOut' <- toCardanoTxOut networkId toCardanoTxOutDatumHash txOut let (Coin minTxOut) = evaluateMinLovelaceOutput pparams (asBabbageBased toShelleyTxOut txOut') missingLovelace = max 0 (Ada.lovelaceOf minTxOut - Ada.fromValue (txOutValue txOut)) pure $ txOut {txOutValue = txOutValue txOut <> Ada.toValue missingLovelace} @@ -402,8 +405,8 @@ writeBalancedTx contractEnv cardanoTx = do -- TODO: This whole part is hacky and we should remove it. let path = Text.unpack $ Files.txFilePath pabConf "raw" (Tx.txId tx') -- We read back the tx from file as tx currently has the wrong id (but the one we create with cardano-cli is correct) - alonzoBody <- firstEitherT (Text.pack . show) $ newEitherT $ readFileTextEnvelope @w (AsTxBody AsBabbageEra) path - let cardanoApiTx = Tx.SomeTx (Tx alonzoBody []) BabbageEraInCardanoMode + babbageBody <- firstEitherT (Text.pack . show) $ newEitherT $ readFileTextEnvelope @w (AsTxBody AsBabbageEra) path + let cardanoApiTx = Tx.SomeTx (Tx babbageBody []) BabbageEraInCardanoMode if signable then newEitherT $ CardanoCLI.signTx @w pabConf tx' requiredSigners diff --git a/src/BotPlutusInterface/Files.hs b/src/BotPlutusInterface/Files.hs index ab57c464..99fb3baf 100644 --- a/src/BotPlutusInterface/Files.hs +++ b/src/BotPlutusInterface/Files.hs @@ -59,7 +59,7 @@ import Data.ByteString.Lazy qualified as LazyByteString import Data.ByteString.Short qualified as ShortByteString import Data.Either.Combinators (mapLeft) import Data.Kind (Type) -import Data.List (sortOn) +import Data.List (sortOn, unzip4) import Data.Map (Map) import Data.Map qualified as Map import Data.Maybe (catMaybes, mapMaybe) @@ -71,6 +71,7 @@ import Ledger.Crypto qualified as Crypto import Ledger.Tx (Tx) import Ledger.Tx qualified as Tx import Ledger.Value qualified as Value +import Plutus.Script.Utils.Scripts qualified as Scripts import Plutus.Script.Utils.V1.Scripts qualified as Scripts import Plutus.V1.Ledger.Api ( CurrencySymbol, @@ -184,10 +185,10 @@ writeAll pabConf tx = do -- TODO: Removed for now, as the main iohk branch doesn't support metadata yet -- createDirectoryIfMissing @w False (Text.unpack pabConf.pcMetadataDir) - let (validatorScripts, redeemers, datums) = - unzip3 $ mapMaybe Tx.inScripts $ Set.toList $ Tx.txInputs tx + let (plutusVersions, validatorScripts, redeemers, datums) = + unzip4 $ mapMaybe Tx.inScripts $ Tx.txInputs tx - policyScripts = Set.toList $ Tx.txMintScripts tx + policyScripts = Map.elems $ Tx.txMintScripts tx allDatums = datums <> Map.elems (Tx.txData tx) allRedeemers = redeemers <> Map.elems (Tx.txRedeemers tx) diff --git a/src/BotPlutusInterface/TimeSlot.hs b/src/BotPlutusInterface/TimeSlot.hs index b95414e3..3c8ce030 100644 --- a/src/BotPlutusInterface/TimeSlot.hs +++ b/src/BotPlutusInterface/TimeSlot.hs @@ -23,8 +23,8 @@ import BotPlutusInterface.Types ( ) import Cardano.Api (CardanoMode, EraHistory) import Cardano.Api qualified as CAPI -import Cardano.Ledger.Alonzo (AlonzoEra) -import Cardano.Ledger.Alonzo.PParams (PParams, _protocolVersion) +-- import Cardano.Ledger.Alonzo (AlonzoEra) +import Cardano.Ledger.Babbage.PParams (PParams, _protocolVersion) import Cardano.Ledger.Alonzo.TxInfo (slotToPOSIXTime) import Cardano.Ledger.Crypto (StandardCrypto) import Cardano.Ledger.Slot (EpochInfo) @@ -56,6 +56,7 @@ import Ouroboros.Consensus.HardFork.History qualified as Consensus import Ouroboros.Consensus.HardFork.History.Qry qualified as HF import System.Environment (getEnv) import Prelude +import Cardano.Ledger.Babbage (BabbageEra) -- | Error returned by the functions of this module data TimeSlotConversionError @@ -72,7 +73,7 @@ slotToPOSIXTimeIO pabConf lSlot = runEitherT $ do sysStart <- newET $ querySystemStart nodeInfo pparams <- liftEither - . fmap (CAPI.toLedgerPParams CAPI.ShelleyBasedEraAlonzo) + . fmap (CAPI.toLedgerPParams CAPI.ShelleyBasedEraBabbage) . maybeToEither (TimeSlotConversionError "No protocol params found") $ pcProtocolParams pabConf let epochInfo = toLedgerEpochInfo eraHistory @@ -112,7 +113,7 @@ posixTimeRangeToContainedSlotRangeIO eraHistory <- newET $ queryEraHistory nodeInfo pparams <- liftEither - . fmap (CAPI.toLedgerPParams CAPI.ShelleyBasedEraAlonzo) + . fmap (CAPI.toLedgerPParams CAPI.ShelleyBasedEraBabbage) . maybeToEither (TimeSlotConversionError "No protocol params found") $ pcProtocolParams pabConf let epochInfo = toLedgerEpochInfo eraHistory @@ -155,7 +156,7 @@ posixTimeRangeToContainedSlotRangeIO -- if bound is not `NegInf` or `PosInf`, then `Closure` need to be calculated -- https://github.com/input-output-hk/plutus-apps/blob/e51f57fa99f4cc0942ba6476b0689e43f0948eb3/plutus-ledger/src/Ledger/TimeSlot.hs#L125-L130 getExtClosure :: - PParams (AlonzoEra StandardCrypto) -> + PParams (BabbageEra StandardCrypto) -> EpochInfo (Either Text) -> SystemStart -> Extended Ledger.Slot -> diff --git a/src/BotPlutusInterface/UtxoParser.hs b/src/BotPlutusInterface/UtxoParser.hs index 8b1033fc..7ba66dfb 100644 --- a/src/BotPlutusInterface/UtxoParser.hs +++ b/src/BotPlutusInterface/UtxoParser.hs @@ -29,19 +29,20 @@ import Data.Attoparsec.Text ( ) import Data.Functor (($>)) import Data.Text (Text) -import Ledger (Address (addressCredential)) +import Ledger (Address (addressCredential), Datum, Script (Script)) import Ledger.Ada qualified as Ada import Ledger.Scripts (DatumHash (..)) import Ledger.Tx (ChainIndexTxOut (PublicKeyChainIndexTxOut, ScriptChainIndexTxOut), TxId (..), TxOutRef (..)) import Ledger.Value (AssetClass, Value) import Ledger.Value qualified as Value +import Plutus.Script.Utils.Scripts qualified as Scripts import Plutus.V1.Ledger.Api ( BuiltinByteString, Credential (PubKeyCredential, ScriptCredential), CurrencySymbol (..), TokenName (..), ) -import Plutus.V2.Ledger.Api (OutputDatum (NoOutputDatum, OutputDatumHash)) +import Plutus.V2.Ledger.Api (OutputDatum (NoOutputDatum, OutputDatum, OutputDatumHash)) import PlutusTx.Builtins (toBuiltin) import Prelude hiding (takeWhile) @@ -78,10 +79,21 @@ chainIndexTxOutParser address = do case addressCredential address of ScriptCredential validatorHash -> do datumHash <- datumHashParser "DatumHash" - pure $ ScriptChainIndexTxOut address value (Left datumHash) Nothing (Left validatorHash) + pure $ + ScriptChainIndexTxOut + address + value + (datumHash, Nothing) + Nothing + (validatorHash, Nothing) PubKeyCredential _ -> do outputDatum <- outputDatumParser "OutputDatum" - pure $ PublicKeyChainIndexTxOut address value outputDatum Nothing + pure $ + PublicKeyChainIndexTxOut + address + value + (convertOutputDatum outputDatum) + Nothing valueParser :: Parser Value valueParser = do @@ -109,11 +121,19 @@ tokenNameParser = do void $ optional $ string "0x" TokenName <$> decodeHash (takeWhile (not . isSpace)) +convertOutputDatum :: OutputDatum -> Maybe (DatumHash, Maybe Datum) +convertOutputDatum = \case + -- FIXME" tmp implementation, check if something exists already + NoOutputDatum -> Nothing + OutputDatumHash dh -> Just (dh, Nothing) + OutputDatum d -> Just (Scripts.datumHash d, Just d) + -- TODO: Handle inline datums, if we need them here outputDatumParser :: Parser OutputDatum outputDatumParser = OutputDatumHash <$> datumHashParser <|> "TxOutDatumNone" $> NoOutputDatum + <|> "OutputDatum" $> error "OutputDatum not supported yet" -- FIXME: some better handling datumHashParser :: Parser DatumHash datumHashParser = do diff --git a/test/Spec.hs b/test/Spec.hs index d1229492..9fdd1372 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -11,10 +11,14 @@ import Spec.BotPlutusInterface.TxStatusChange qualified import Spec.BotPlutusInterface.UtxoParser qualified import Test.Tasty (TestTree, defaultMain, testGroup) import Prelude +import System.IO -- | @since 0.1 main :: IO () -main = defaultMain tests +main = do + hSetBuffering stdin LineBuffering + hSetBuffering stdout LineBuffering + defaultMain tests {- | Project wide tests diff --git a/test/Spec/BotPlutusInterface/AdjustUnbalanced.hs b/test/Spec/BotPlutusInterface/AdjustUnbalanced.hs index c2b81961..275bd49d 100644 --- a/test/Spec/BotPlutusInterface/AdjustUnbalanced.hs +++ b/test/Spec/BotPlutusInterface/AdjustUnbalanced.hs @@ -48,7 +48,7 @@ tests = testCase "Adjusting unbalanced transaction" testOutsGetAdjusted testOutsGetAdjusted :: Assertion testOutsGetAdjusted = do let txOutRef = TxOutRef "e406b0cf676fc2b1a9edb0617f259ad025c20ea6f0333820aa7cef1bfe7302e5" 0 - txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1350) NoOutputDatum Nothing + txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1350) Nothing Nothing initState = def & utxos .~ [(txOutRef, txOut)] & contractEnv .~ contractEnv' diff --git a/test/Spec/BotPlutusInterface/Balance.hs b/test/Spec/BotPlutusInterface/Balance.hs index 6e4618fe..179324fc 100644 --- a/test/Spec/BotPlutusInterface/Balance.hs +++ b/test/Spec/BotPlutusInterface/Balance.hs @@ -72,7 +72,7 @@ addUtxosForFees = do case ebalancedTx of Left e -> assertFailure (Text.unpack e) - Right balanceTx -> txInputs <$> balanceTx @?= Right (Set.fromList [txIn1, txIn2]) + Right balanceTx -> txInputs <$> balanceTx @?= Right [txIn1, txIn2] addUtxosForNativeTokens :: Assertion addUtxosForNativeTokens = do @@ -95,7 +95,7 @@ addUtxosForNativeTokens = do case ebalancedTx of Left e -> assertFailure (Text.unpack e) - Right balancedTx -> txInputs <$> balancedTx @?= Right (Set.fromList [txIn3, txIn4]) + Right balancedTx -> txInputs <$> balancedTx @?= Right [txIn3, txIn4] addUtxosForChange :: Assertion addUtxosForChange = do @@ -110,4 +110,4 @@ addUtxosForChange = do case ebalancedTx of Left e -> assertFailure (Text.unpack e) - Right balancedTx -> txInputs <$> balancedTx @?= Right (Set.fromList [txIn1, txIn2]) + Right balancedTx -> txInputs <$> balancedTx @?= Right [txIn1, txIn2] diff --git a/test/Spec/BotPlutusInterface/Collateral.hs b/test/Spec/BotPlutusInterface/Collateral.hs index 1d3dfb78..a68f077d 100644 --- a/test/Spec/BotPlutusInterface/Collateral.hs +++ b/test/Spec/BotPlutusInterface/Collateral.hs @@ -66,9 +66,9 @@ tests = testTxUsesCollateralCorrectly :: Assertion testTxUsesCollateralCorrectly = do let txOutRef1 = TxOutRef "e406b0cf676fc2b1a9edb0617f259ad025c20ea6f0333820aa7cef1bfe7302e5" 0 - txOut1 = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 10_000_000) NoOutputDatum Nothing + txOut1 = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 10_000_000) Nothing Nothing txOutRef2 = TxOutRef "d406b0cf676fc2b1a9edb0617f259ad025c20ea6f0333820aa7cef1bfe7302e4" 0 - txOut2 = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 90_000_000) NoOutputDatum Nothing + txOut2 = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 90_000_000) Nothing Nothing cenv' = def {ceCollateral = CollateralVar $ unsafePerformIO $ newTVarIO Nothing} initState = def & utxos .~ [(txOutRef1, txOut1), (txOutRef2, txOut2)] & contractEnv .~ cenv' & collateralUtxo .~ Nothing @@ -107,7 +107,7 @@ testTxUsesCollateralCorrectly = do testTxCreatesCollateralCorrectly :: Assertion testTxCreatesCollateralCorrectly = do let txOutRef1 = TxOutRef "d406b0cf676fc2b1a9edb0617f259ad025c20ea6f0333820aa7cef1bfe7302e4" 0 - txOut1 = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 90_000_000) NoOutputDatum Nothing + txOut1 = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 90_000_000) Nothing Nothing cenv' = def {ceCollateral = CollateralVar $ unsafePerformIO $ newTVarIO Nothing} initState = def & utxos .~ [(txOutRef1, txOut1)] & contractEnv .~ cenv' & collateralUtxo .~ Nothing @@ -151,7 +151,7 @@ curSymbol' = encodeByteString $ fromBuiltin $ Value.unCurrencySymbol curSymbol mintContract :: Contract () (Endpoint "SendAda" ()) Text CardanoTx mintContract = do let lookups = - Constraints.mintingPolicy mintingPolicy + Constraints.plutusV1MintingPolicy mintingPolicy let constraints = Constraints.mustMintValue (Value.singleton curSymbol "testToken" 5) <> Constraints.mustPayToPubKey diff --git a/test/Spec/BotPlutusInterface/Contract.hs b/test/Spec/BotPlutusInterface/Contract.hs index 96c5675b..43cb5ea7 100644 --- a/test/Spec/BotPlutusInterface/Contract.hs +++ b/test/Spec/BotPlutusInterface/Contract.hs @@ -49,7 +49,7 @@ import Plutus.Contract ( utxosAt, waitNSlots, ) -import Plutus.Script.Utils.V1.Scripts qualified as ScriptUtils +import Plutus.Script.Utils.Scripts qualified as ScriptUtils import PlutusTx qualified import PlutusTx.Builtins (fromBuiltin) import Pretty.Diff ( @@ -83,6 +83,7 @@ import Spec.MockContract ( import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, testCase, (@?=)) import Prelude +import Plutus.Script.Utils.Scripts qualified as Scripts {- | Contract tests @@ -111,7 +112,7 @@ tests = sendAda :: Assertion sendAda = do let txOutRef = TxOutRef "e406b0cf676fc2b1a9edb0617f259ad025c20ea6f0333820aa7cef1bfe7302e5" 0 - txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1350) NoOutputDatum Nothing + txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1350) Nothing Nothing -- We append the new utxo with the already present collateral utxo present at `pkhAddr1`. initState = def & utxos <>~ [(txOutRef, txOut)] @@ -184,7 +185,7 @@ sendAda = do sendAdaNoChange :: Assertion sendAdaNoChange = do let txOutRef = TxOutRef "e406b0cf676fc2b1a9edb0617f259ad025c20ea6f0333820aa7cef1bfe7302e5" 0 - txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1200) NoOutputDatum Nothing + txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1200) Nothing Nothing initState = def & utxos <>~ [(txOutRef, txOut)] inTxId = encodeByteString $ fromBuiltin $ Tx.getTxId $ Tx.txOutRefId txOutRef @@ -213,7 +214,7 @@ sendAdaNoChange = do sendAdaStaking :: Assertion sendAdaStaking = do let txOutRef = TxOutRef "e406b0cf676fc2b1a9edb0617f259ad025c20ea6f0333820aa7cef1bfe7302e5" 0 - txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1200) NoOutputDatum Nothing + txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1200) Nothing Nothing initState = def & utxos <>~ [(txOutRef, txOut)] inTxId = encodeByteString $ fromBuiltin $ Tx.getTxId $ Tx.txOutRefId txOutRef @@ -285,7 +286,7 @@ sendAdaStaking = do multisigSupport :: Assertion multisigSupport = do let txOutRef = TxOutRef "e406b0cf676fc2b1a9edb0617f259ad025c20ea6f0333820aa7cef1bfe7302e5" 0 - txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1200) NoOutputDatum Nothing + txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1200) Nothing Nothing initState = def & utxos <>~ [(txOutRef, txOut)] inTxId = encodeByteString $ fromBuiltin $ Tx.getTxId $ Tx.txOutRefId txOutRef @@ -327,7 +328,7 @@ multisigSupport = do withoutSigning :: Assertion withoutSigning = do let txOutRef = TxOutRef "e406b0cf676fc2b1a9edb0617f259ad025c20ea6f0333820aa7cef1bfe7302e5" 0 - txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1200) NoOutputDatum Nothing + txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1200) Nothing Nothing initState = def & utxos <>~ [(txOutRef, txOut)] @@ -372,11 +373,11 @@ sendTokens = do PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1350 <> Value.singleton "abcd1234" "testToken" 100) - NoOutputDatum + Nothing Nothing txOutRef2 = TxOutRef "e406b0cf676fc2b1a9edb0617f259ad025c20ea6f0333820aa7cef1bfe7302e5" 1 txOut2 = - PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1250) NoOutputDatum Nothing + PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1250) Nothing Nothing initState = def & utxos <>~ [(txOutRef1, txOut1), (txOutRef2, txOut2)] inTxId1 = encodeByteString $ fromBuiltin $ Tx.getTxId $ Tx.txOutRefId txOutRef1 @@ -409,10 +410,10 @@ sendTokensWithoutName :: Assertion sendTokensWithoutName = do let txOutRef1 = TxOutRef "08b27dbdcff9ab3b432638536ec7eab36c8a2e457703fb1b559dd754032ef431" 0 txOut1 = - PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1350 <> Value.singleton "abcd1234" "" 100) NoOutputDatum Nothing + PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1350 <> Value.singleton "abcd1234" "" 100) Nothing Nothing txOutRef2 = TxOutRef "e406b0cf676fc2b1a9edb0617f259ad025c20ea6f0333820aa7cef1bfe7302e5" 1 txOut2 = - PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1250) NoOutputDatum Nothing + PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1250) Nothing Nothing initState = def & utxos <>~ [(txOutRef1, txOut1), (txOutRef2, txOut2)] inTxId1 = encodeByteString $ fromBuiltin $ Tx.getTxId $ Tx.txOutRefId txOutRef1 @@ -444,7 +445,7 @@ sendTokensWithoutName = do mintTokens :: Assertion mintTokens = do let txOutRef = TxOutRef "e406b0cf676fc2b1a9edb0617f259ad025c20ea6f0333820aa7cef1bfe7302e5" 0 - txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1_000_000) NoOutputDatum Nothing + txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1_000_000) Nothing Nothing initState = def & utxos <>~ [(txOutRef, txOut)] inTxId = encodeByteString $ fromBuiltin $ Tx.getTxId $ Tx.txOutRefId txOutRef collateralTxId = encodeByteString $ fromBuiltin $ Tx.getTxId theCollateralTxId @@ -454,8 +455,8 @@ mintTokens = do Scripts.mkMintingPolicyScript $$(PlutusTx.compile [||(\_ _ -> ())||]) - curSymbol :: Value.CurrencySymbol - curSymbol = ScriptUtils.scriptCurrencySymbol mintingPolicy + curSymbol :: Ledger.CurrencySymbol + curSymbol = Ledger.scriptCurrencySymbol mintingPolicy curSymbol' :: Text curSymbol' = encodeByteString $ fromBuiltin $ Value.unCurrencySymbol curSymbol @@ -467,7 +468,7 @@ mintTokens = do contract :: Contract () (Endpoint "SendAda" ()) Text CardanoTx contract = do let lookups = - Constraints.mintingPolicy mintingPolicy + Constraints.plutusV1MintingPolicy mintingPolicy let constraints = Constraints.mustMintValue (Value.singleton curSymbol "testToken" 5) <> Constraints.mustPayToPubKey @@ -525,7 +526,7 @@ mintTokens = do spendToValidator :: Assertion spendToValidator = do let txOutRef = TxOutRef "e406b0cf676fc2b1a9edb0617f259ad025c20ea6f0333820aa7cef1bfe7302e5" 0 - txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1000) NoOutputDatum Nothing + txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1000) Nothing Nothing initState = def & utxos <>~ [(txOutRef, txOut)] inTxId = encodeByteString $ fromBuiltin $ Tx.getTxId $ Tx.txOutRefId txOutRef @@ -534,8 +535,8 @@ spendToValidator = do Scripts.mkValidatorScript $$(PlutusTx.compile [||(\_ _ _ -> ())||]) - valHash :: ScriptUtils.ValidatorHash - valHash = ScriptUtils.validatorHash validator + valHash :: Ledger.ValidatorHash + valHash = Ledger.validatorHash validator valAddr :: Ledger.Address valAddr = scriptHashAddress $ validatorHash validator @@ -562,7 +563,7 @@ spendToValidator = do contract = do utxos' <- utxosAt valAddr let lookups = - Constraints.otherScript validator + Constraints.plutusV1OtherScript validator <> Constraints.otherData datum <> Constraints.unspentOutputs utxos' let constraints = @@ -610,15 +611,15 @@ spendToValidator = do redeemFromValidator :: Assertion redeemFromValidator = do let txOutRef = TxOutRef "e406b0cf676fc2b1a9edb0617f259ad025c20ea6f0333820aa7cef1bfe7302e5" 0 - txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1_000_000) NoOutputDatum Nothing + txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1_000_000) Nothing Nothing txOutRef' = TxOutRef "e406b0cf676fc2b1a9edb0617f259ad025c20ea6f0333820aa7cef1bfe7302e5" 1 txOut' = ScriptChainIndexTxOut valAddr (Ada.lovelaceValueOf 1250) - (Left datumHash) + (datumHash, Nothing) Nothing - (Right validator) + (validatorHash validator, Just validator) initState = def & utxos <>~ [(txOutRef, txOut), (txOutRef', txOut')] inTxId = encodeByteString $ fromBuiltin $ Tx.getTxId $ Tx.txOutRefId txOutRef collateralTxId = encodeByteString $ fromBuiltin $ Tx.getTxId theCollateralTxId @@ -657,7 +658,7 @@ redeemFromValidator = do contract = do utxos' <- utxosAt valAddr let lookups = - Constraints.otherScript validator + Constraints.plutusV1OtherScript validator <> Constraints.otherData datum <> Constraints.unspentOutputs utxos' let constraints = @@ -715,7 +716,7 @@ redeemFromValidator = do multiTx :: Assertion multiTx = do let txOutRef = TxOutRef "e406b0cf676fc2b1a9edb0617f259ad025c20ea6f0333820aa7cef1bfe7302e5" 0 - txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1200) NoOutputDatum Nothing + txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1200) Nothing Nothing initState = def & utxos <>~ [(txOutRef, txOut)] contract :: Contract () (Endpoint "SendAda" ()) Text [CardanoTx] @@ -744,7 +745,7 @@ multiTx = do withValidRange :: Assertion withValidRange = do let txOutRef = TxOutRef "e406b0cf676fc2b1a9edb0617f259ad025c20ea6f0333820aa7cef1bfe7302e5" 0 - txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1200) NoOutputDatum Nothing + txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1200) Nothing Nothing initState = def & utxos <>~ [(txOutRef, txOut)] inTxId = encodeByteString $ fromBuiltin $ Tx.getTxId $ Tx.txOutRefId txOutRef @@ -789,7 +790,7 @@ withValidRange = do useWriter :: Assertion useWriter = do let txOutRef = TxOutRef "e406b0cf676fc2b1a9edb0617f259ad025c20ea6f0333820aa7cef1bfe7302e5" 0 - txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1200) NoOutputDatum Nothing + txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1200) Nothing Nothing initState = def & utxos <>~ [(txOutRef, txOut)] contract :: Contract (Last Text) (Endpoint "SendAda" ()) Text CardanoTx diff --git a/test/Spec/BotPlutusInterface/ContractStats.hs b/test/Spec/BotPlutusInterface/ContractStats.hs index cfdc09b0..1a5da85a 100644 --- a/test/Spec/BotPlutusInterface/ContractStats.hs +++ b/test/Spec/BotPlutusInterface/ContractStats.hs @@ -43,7 +43,7 @@ tests = budgetSavingEnabled :: Assertion budgetSavingEnabled = do let txOutRef = TxOutRef "e406b0cf676fc2b1a9edb0617f259ad025c20ea6f0333820aa7cef1bfe7302e5" 0 - txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1350) NoOutputDatum Nothing + txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1350) Nothing Nothing initState = def & utxos .~ [(txOutRef, txOut)] & contractEnv .~ contractEnv' @@ -63,7 +63,7 @@ budgetSavingEnabled = do budgetSavingDisabled :: Assertion budgetSavingDisabled = do let txOutRef = TxOutRef "e406b0cf676fc2b1a9edb0617f259ad025c20ea6f0333820aa7cef1bfe7302e5" 0 - txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1350) NoOutputDatum Nothing + txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1350) Nothing Nothing initState = def & utxos .~ [(txOutRef, txOut)] contract :: Contract () (Endpoint "SendAda" ()) Text CardanoTx diff --git a/test/Spec/BotPlutusInterface/TxStatusChange.hs b/test/Spec/BotPlutusInterface/TxStatusChange.hs index d689460f..009ae546 100644 --- a/test/Spec/BotPlutusInterface/TxStatusChange.hs +++ b/test/Spec/BotPlutusInterface/TxStatusChange.hs @@ -48,7 +48,7 @@ tests = testTxFoundAndConfirmed :: Assertion testTxFoundAndConfirmed = do let txOutRef = TxOutRef "e406b0cf676fc2b1a9edb0617f259ad025c20ea6f0333820aa7cef1bfe7302e5" 0 - txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1350) NoOutputDatum Nothing + txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1350) Nothing Nothing initState = def & utxos .~ [(txOutRef, txOut)] & contractEnv .~ contractEnv' diff --git a/test/Spec/BotPlutusInterface/UtxoParser.hs b/test/Spec/BotPlutusInterface/UtxoParser.hs index 2b96ae92..eb0471b5 100644 --- a/test/Spec/BotPlutusInterface/UtxoParser.hs +++ b/test/Spec/BotPlutusInterface/UtxoParser.hs @@ -64,7 +64,7 @@ singleAdaOnly = do |] [ ( TxOutRef "384de3f29396fdf687551e3f9e05bd400adcd277720c71f1d2b61f17f5183e51" 0 - , PublicKeyChainIndexTxOut addr (Ada.lovelaceValueOf 5000000000) NoOutputDatum Nothing + , PublicKeyChainIndexTxOut addr (Ada.lovelaceValueOf 5000000000) Nothing Nothing ) ] @@ -81,15 +81,15 @@ multiAdaOnly = do |] [ ( TxOutRef "384de3f29396fdf687551e3f9e05bd400adcd277720c71f1d2b61f17f5183e51" 0 - , PublicKeyChainIndexTxOut addr (Ada.lovelaceValueOf 5000000000) NoOutputDatum Nothing + , PublicKeyChainIndexTxOut addr (Ada.lovelaceValueOf 5000000000) Nothing Nothing ) , ( TxOutRef "52a003b3f4956433429631afe4002f82a924a5a7a891db7ae1f6434797a57dff" 1 - , PublicKeyChainIndexTxOut addr (Ada.lovelaceValueOf 89835907) NoOutputDatum Nothing + , PublicKeyChainIndexTxOut addr (Ada.lovelaceValueOf 89835907) Nothing Nothing ) , ( TxOutRef "d8a5630a9d7e913f9d186c95e5138a239a4e79ece3414ac894dbf37280944de3" 0 - , PublicKeyChainIndexTxOut addr (Ada.lovelaceValueOf 501000123456) NoOutputDatum Nothing + , PublicKeyChainIndexTxOut addr (Ada.lovelaceValueOf 501000123456) Nothing Nothing ) ] @@ -119,7 +119,7 @@ singleWithNativeTokens = do <> Value.assetClassValue tokenWithRawByteString 3456 <> Value.assetClassValue tokenWithEmptyName 4567 ) - NoOutputDatum + Nothing Nothing ) ] @@ -138,9 +138,9 @@ singleWithDatum = do , ScriptChainIndexTxOut addr (Ada.lovelaceValueOf 5000000000) - (Left "2cdb268baecefad822e5712f9e690e1787f186f5c84c343ffdc060b21f0241e0") + ("2cdb268baecefad822e5712f9e690e1787f186f5c84c343ffdc060b21f0241e0", Nothing) Nothing - (Left "0000") + ("0000", Nothing) ) ] @@ -158,7 +158,7 @@ pkhAddrWithDatum = do , PublicKeyChainIndexTxOut addr (Ada.lovelaceValueOf 5000000000) - (OutputDatumHash "2cdb268baecefad822e5712f9e690e1787f186f5c84c343ffdc060b21f0241e0") + (Just ("2cdb268baecefad822e5712f9e690e1787f186f5c84c343ffdc060b21f0241e0", Nothing)) Nothing ) ] diff --git a/test/Spec/MockContract.hs b/test/Spec/MockContract.hs index ccb07bc0..c7d7f291 100644 --- a/test/Spec/MockContract.hs +++ b/test/Spec/MockContract.hs @@ -125,6 +125,7 @@ import Data.Text.Encoding (decodeUtf8) import Data.Tuple.Extra (first) import Data.UUID qualified as UUID import GHC.IO.Exception (IOErrorType (NoSuchThing), IOException (IOError)) +import Plutus.Script.Utils.Scripts qualified as Scripts import Ledger ( Extended (NegInf, PosInf), Interval (Interval), @@ -287,7 +288,7 @@ instance Monoid w => Default (MockContractState w) where _utxos = [ ( collateralTxOutRef theCollateralUtxo - , PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf $ toInteger $ pcCollateralSize def) NoOutputDatum Nothing + , PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf $ toInteger $ pcCollateralSize def) Nothing Nothing ) ] , _tip = Tip 1000 (BlockId "ab12") 4 @@ -493,13 +494,13 @@ mockQueryUtxoOut utxos' = txOutToDatum :: ChainIndexTxOut -> Text txOutToDatum = \case - PublicKeyChainIndexTxOut _ _ NoOutputDatum _ -> "TxOutDatumNone" - PublicKeyChainIndexTxOut _ _ (OutputDatumHash (DatumHash dh)) _ -> printDatumHash dh - PublicKeyChainIndexTxOut _ _ (OutputDatum (Datum d)) _ -> printDatum d - ScriptChainIndexTxOut _ _ (Left (DatumHash dh)) _ _ -> printDatumHash dh - ScriptChainIndexTxOut _ _ (Right (Datum d)) _ _ -> printDatum d + PublicKeyChainIndexTxOut _ _ Nothing _ -> "TxOutDatumNone" + PublicKeyChainIndexTxOut _ _ (Just (dh, Nothing)) _ -> printDatumHash dh + PublicKeyChainIndexTxOut _ _ (Just (_, Just (Datum d))) _ -> printDatum d + ScriptChainIndexTxOut _ _ (dh, Nothing) _ _ -> printDatumHash dh + ScriptChainIndexTxOut _ _ (_, Just (Datum d)) _ _ -> printDatum d where - printDatumHash dh = + printDatumHash (DatumHash dh) = "TxDatumHash ScriptDataInBabbageEra " <> encodeByteString (fromBuiltin dh) printDatum d = "TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra " @@ -699,18 +700,25 @@ buildOutputsFromKnownUTxOs knownUtxos txId = ValidTx $ map converCiTxOut $ fillG PublicKeyChainIndexTxOut (Ledger.Address (PubKeyCredential "") Nothing) mempty - NoOutputDatum + Nothing Nothing converCiTxOut :: ChainIndexTxOut -> CIT.ChainIndexTxOut converCiTxOut (PublicKeyChainIndexTxOut addr val dat maybeRefSc) = - CIT.ChainIndexTxOut addr val dat (convertRefScript maybeRefSc) + CIT.ChainIndexTxOut addr val (convertMaybeDatum dat) (convertRefScript maybeRefSc) converCiTxOut (ScriptChainIndexTxOut addr val eitherDatum maybeRefSc _) = let datum = case eitherDatum of - Left dh -> OutputDatumHash dh - Right d -> OutputDatum d + (dh, Nothing) -> OutputDatumHash dh + (_, Just d) -> OutputDatum d in CIT.ChainIndexTxOut addr val datum (convertRefScript maybeRefSc) +convertMaybeDatum :: Maybe (DatumHash, Maybe Datum) -> OutputDatum +convertMaybeDatum = \case + -- FIXME" tmp implementation, check if something exists already for such conversion + Nothing -> NoOutputDatum + Just (dh, Nothing) -> OutputDatumHash dh + Just (_dh, Just d) -> OutputDatum d + convertRefScript :: Maybe V1.Script -> ReferenceScript convertRefScript = \case From 2feccf03b38033f5a0fb71a850de0e335318c263 Mon Sep 17 00:00:00 2001 From: Mitch Notarnicola Date: Tue, 16 Aug 2022 22:51:33 -0400 Subject: [PATCH 2/4] clean up changes --- bot-plutus-interface.cabal | 4 +--- src/BotPlutusInterface/Balance.hs | 1 - src/BotPlutusInterface/CardanoCLI.hs | 12 ++++++------ src/BotPlutusInterface/Contract.hs | 10 +++++----- src/BotPlutusInterface/Files.hs | 15 +++++++-------- src/BotPlutusInterface/TimeSlot.hs | 6 ++++-- src/BotPlutusInterface/UtxoParser.hs | 6 +++--- test/Spec.hs | 4 +--- test/Spec/BotPlutusInterface/AdjustUnbalanced.hs | 1 - test/Spec/BotPlutusInterface/Balance.hs | 1 - test/Spec/BotPlutusInterface/Collateral.hs | 3 +-- test/Spec/BotPlutusInterface/Config.hs | 1 + test/Spec/BotPlutusInterface/Contract.hs | 10 ++++------ test/Spec/BotPlutusInterface/ContractStats.hs | 1 - test/Spec/BotPlutusInterface/TxStatusChange.hs | 2 +- test/Spec/BotPlutusInterface/UtxoParser.hs | 1 - test/Spec/MockContract.hs | 9 ++++----- 17 files changed, 38 insertions(+), 49 deletions(-) diff --git a/bot-plutus-interface.cabal b/bot-plutus-interface.cabal index 8919179f..34926324 100644 --- a/bot-plutus-interface.cabal +++ b/bot-plutus-interface.cabal @@ -27,9 +27,7 @@ common common-lang -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fobject-code -fno-ignore-interface-pragmas -fno-omit-interface-pragmas - -fplugin=RecordDotPreprocessor - - -- -Werror + -fplugin=RecordDotPreprocessor -Werror build-depends: , base diff --git a/src/BotPlutusInterface/Balance.hs b/src/BotPlutusInterface/Balance.hs index 5d0a4c32..b46aa52c 100644 --- a/src/BotPlutusInterface/Balance.hs +++ b/src/BotPlutusInterface/Balance.hs @@ -315,7 +315,6 @@ balanceTxIns utxos tx = do -- FIXME: maybe better way to handle to <> from Set, as now using list here will break balancing -- constantly adding inputs and running balance loop forever pure $ tx {txInputs = Set.toList (txIns <> Set.fromList (txInputs tx))} - -- | Set collateral or fail in case it's required but not available addTxCollaterals :: CollateralUtxo -> Tx -> Tx diff --git a/src/BotPlutusInterface/CardanoCLI.hs b/src/BotPlutusInterface/CardanoCLI.hs index 1e07fd66..5f632546 100644 --- a/src/BotPlutusInterface/CardanoCLI.hs +++ b/src/BotPlutusInterface/CardanoCLI.hs @@ -55,7 +55,7 @@ import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Text qualified as Text import Data.Text.Encoding (decodeUtf8) -import Ledger (MintingPolicy, MintingPolicyHash, Slot (Slot), SlotRange) -- FIXME" consider qualified imports as before +import Ledger (Slot (Slot), SlotRange) import Ledger qualified import Ledger.Ada (fromValue, getLovelace) import Ledger.Ada qualified as Ada @@ -73,7 +73,7 @@ import Ledger.Tx (ChainIndexTxOut, RedeemerPtr (..), Redeemers, ScriptTag (..), import Ledger.Tx.CardanoAPI (toCardanoAddressInEra) import Ledger.Value (Value) import Ledger.Value qualified as Value -import Plutus.Script.Utils.Scripts qualified as Scripts +import Plutus.Script.Utils.Scripts qualified as ScriptUtils import Plutus.V1.Ledger.Api ( CurrencySymbol (..), ExBudget (..), @@ -262,11 +262,11 @@ txInOpts spendIndex pabConf = ] , [ "--tx-in-datum-file" - , datumJsonFilePath pabConf (Scripts.datumHash datum) + , datumJsonFilePath pabConf (ScriptUtils.datumHash datum) ] , [ "--tx-in-redeemer-file" - , redeemerJsonFilePath pabConf (Scripts.redeemerHash redeemer) + , redeemerJsonFilePath pabConf (ScriptUtils.redeemerHash redeemer) ] , [ "--tx-in-execution-units" @@ -285,7 +285,7 @@ txInCollateralOpts = mintOpts :: MintBudgets -> PABConfig -> - Map MintingPolicyHash MintingPolicy -> + Map Ledger.MintingPolicyHash Ledger.MintingPolicy -> Redeemers -> Value -> ([Text], ExBudget) @@ -305,7 +305,7 @@ mintOpts mintIndex pabConf mintingPolicies redeemers mintValue = (,exBudget) $ mconcat [ ["--mint-script-file", policyScriptFilePath pabConf curSymbol] - , ["--mint-redeemer-file", redeemerJsonFilePath pabConf (Scripts.redeemerHash r)] + , ["--mint-redeemer-file", redeemerJsonFilePath pabConf (ScriptUtils.redeemerHash r)] , ["--mint-execution-units", exBudgetToCliArg exBudget] ] in orMempty $ fmap toOpts redeemer diff --git a/src/BotPlutusInterface/Contract.hs b/src/BotPlutusInterface/Contract.hs index 799a764c..31d62417 100644 --- a/src/BotPlutusInterface/Contract.hs +++ b/src/BotPlutusInterface/Contract.hs @@ -71,7 +71,6 @@ import Data.List.NonEmpty (NonEmpty ((:|))) import Data.Map qualified as Map import Data.Row (Row) import Data.Text (Text) -import Data.Text qualified as T import Data.Text qualified as Text import Data.Vector qualified as V import Ledger (POSIXTime, getCardanoTxId) @@ -82,10 +81,13 @@ import Ledger.Constraints.OffChain (UnbalancedTx (..), tx) import Ledger.Slot (Slot (Slot)) import Ledger.Tx (CardanoTx (CardanoApiTx, EmulatorTx), outputs) import Ledger.Tx qualified as Tx +import Ledger.Tx.CardanoAPI (toCardanoTxOut, toCardanoTxOutDatumHash) import Ledger.Validation (Coin (Coin)) import Plutus.ChainIndex.TxIdState (fromTx, transactionStatus) import Plutus.ChainIndex.Types (RollbackState (..), TxIdState, TxStatus) + -- import Plutus.Contract.CardanoAPI (toCardanoTxOutBabbage, toCardanoTxOutDatumHashBabbage) + import Plutus.Contract.Checkpoint (Checkpoint (..)) import Plutus.Contract.Effects ( BalanceTxResponse (..), @@ -103,7 +105,6 @@ import Prettyprinter (Pretty (pretty), (<+>)) import Prettyprinter qualified as PP import Wallet.Emulator.Error (WalletAPIError (..)) import Prelude -import Ledger.Tx.CardanoAPI (toCardanoTxOut, toCardanoTxOutDatumHash) runContract :: forall (w :: Type) (s :: Row Type) (e :: Type) (a :: Type). @@ -230,7 +231,6 @@ handlePABReq contractEnv req = do ExposeEndpointReq _ -> error ("Unsupported PAB effect: " ++ show req) YieldUnbalancedTxReq _ -> error ("Unsupported PAB effect: " ++ show req) CurrentChainIndexSlotReq -> error ("Unsupported PAB effect: " ++ show req) - printBpiLog @w (Debug [PABLog]) $ pretty resp pure resp @@ -569,7 +569,7 @@ makeCollateral cEnv = runEitherT $ do let pabConf = cEnv.cePABConfig unbalancedTx <- - firstEitherT (T.pack . show) $ + firstEitherT (Text.pack . show) $ hoistEither $ Collateral.mkCollateralTx pabConf balancedTx <- @@ -581,7 +581,7 @@ makeCollateral cEnv = runEitherT $ do wbr <- lift $ writeBalancedTx cEnv (EmulatorTx balancedTx) case wbr of - WriteBalancedTxFailed e -> throwE . T.pack $ "Failed to create collateral output: " <> show e + WriteBalancedTxFailed e -> throwE . Text.pack $ "Failed to create collateral output: " <> show e WriteBalancedTxSuccess cTx -> do status <- lift $ awaitTxStatusChange cEnv (getCardanoTxId cTx) lift $ printBpiLog @w (Notice [CollateralLog]) $ "Collateral Tx Status: " <> pretty status diff --git a/src/BotPlutusInterface/Files.hs b/src/BotPlutusInterface/Files.hs index 99fb3baf..8a33f636 100644 --- a/src/BotPlutusInterface/Files.hs +++ b/src/BotPlutusInterface/Files.hs @@ -63,7 +63,6 @@ import Data.List (sortOn, unzip4) import Data.Map (Map) import Data.Map qualified as Map import Data.Maybe (catMaybes, mapMaybe) -import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as Text import Ledger.Crypto (PubKey (PubKey), PubKeyHash (PubKeyHash)) @@ -71,8 +70,8 @@ import Ledger.Crypto qualified as Crypto import Ledger.Tx (Tx) import Ledger.Tx qualified as Tx import Ledger.Value qualified as Value -import Plutus.Script.Utils.Scripts qualified as Scripts -import Plutus.Script.Utils.V1.Scripts qualified as Scripts +import Plutus.Script.Utils.Scripts qualified as ScriptUtils +import Plutus.Script.Utils.V1.Scripts qualified as ScriptUtils import Plutus.V1.Ledger.Api ( CurrencySymbol, Datum (getDatum), @@ -146,7 +145,7 @@ writePolicyScriptFile :: Eff effs (Either (FileError ()) Text) writePolicyScriptFile pabConf mintingPolicy = let script = serialiseScript $ Ledger.unMintingPolicyScript mintingPolicy - filepath = policyScriptFilePath pabConf (Scripts.scriptCurrencySymbol mintingPolicy) + filepath = policyScriptFilePath pabConf (ScriptUtils.scriptCurrencySymbol mintingPolicy) in fmap (const filepath) <$> writeFileTextEnvelope @w (Text.unpack filepath) Nothing script -- | Compiles and writes a script file under the given folder @@ -158,7 +157,7 @@ writeValidatorScriptFile :: Eff effs (Either (FileError ()) Text) writeValidatorScriptFile pabConf validatorScript = let script = serialiseScript $ Ledger.unValidatorScript validatorScript - filepath = validatorScriptFilePath pabConf (Scripts.validatorHash validatorScript) + filepath = validatorScriptFilePath pabConf (ScriptUtils.validatorHash validatorScript) in fmap (const filepath) <$> writeFileTextEnvelope @w (Text.unpack filepath) Nothing script -- TODO: Removed for now, as the main iohk branch doesn't support metadata yet @@ -185,7 +184,7 @@ writeAll pabConf tx = do -- TODO: Removed for now, as the main iohk branch doesn't support metadata yet -- createDirectoryIfMissing @w False (Text.unpack pabConf.pcMetadataDir) - let (plutusVersions, validatorScripts, redeemers, datums) = + let (_, validatorScripts, redeemers, datums) = unzip4 $ mapMaybe Tx.inScripts $ Tx.txInputs tx policyScripts = Map.elems $ Tx.txMintScripts tx @@ -311,7 +310,7 @@ writeDatumJsonFile :: Eff effs (Either (FileError ()) Text) writeDatumJsonFile pabConf datum = let json = dataToJson $ getDatum datum - filepath = datumJsonFilePath pabConf (Scripts.datumHash datum) + filepath = datumJsonFilePath pabConf (ScriptUtils.datumHash datum) in fmap (const filepath) <$> writeFileJSON @w (Text.unpack filepath) json writeRedeemerJsonFile :: @@ -322,7 +321,7 @@ writeRedeemerJsonFile :: Eff effs (Either (FileError ()) Text) writeRedeemerJsonFile pabConf redeemer = let json = dataToJson $ getRedeemer redeemer - filepath = redeemerJsonFilePath pabConf (Scripts.redeemerHash redeemer) + filepath = redeemerJsonFilePath pabConf (ScriptUtils.redeemerHash redeemer) in fmap (const filepath) <$> writeFileJSON @w (Text.unpack filepath) json dataToJson :: forall (a :: Type). ToData a => a -> JSON.Value diff --git a/src/BotPlutusInterface/TimeSlot.hs b/src/BotPlutusInterface/TimeSlot.hs index 3c8ce030..8559292b 100644 --- a/src/BotPlutusInterface/TimeSlot.hs +++ b/src/BotPlutusInterface/TimeSlot.hs @@ -23,9 +23,12 @@ import BotPlutusInterface.Types ( ) import Cardano.Api (CardanoMode, EraHistory) import Cardano.Api qualified as CAPI + -- import Cardano.Ledger.Alonzo (AlonzoEra) -import Cardano.Ledger.Babbage.PParams (PParams, _protocolVersion) + import Cardano.Ledger.Alonzo.TxInfo (slotToPOSIXTime) +import Cardano.Ledger.Babbage (BabbageEra) +import Cardano.Ledger.Babbage.PParams (PParams, _protocolVersion) import Cardano.Ledger.Crypto (StandardCrypto) import Cardano.Ledger.Slot (EpochInfo) import Cardano.Prelude (maybeToEither) @@ -56,7 +59,6 @@ import Ouroboros.Consensus.HardFork.History qualified as Consensus import Ouroboros.Consensus.HardFork.History.Qry qualified as HF import System.Environment (getEnv) import Prelude -import Cardano.Ledger.Babbage (BabbageEra) -- | Error returned by the functions of this module data TimeSlotConversionError diff --git a/src/BotPlutusInterface/UtxoParser.hs b/src/BotPlutusInterface/UtxoParser.hs index 7ba66dfb..20439294 100644 --- a/src/BotPlutusInterface/UtxoParser.hs +++ b/src/BotPlutusInterface/UtxoParser.hs @@ -29,13 +29,13 @@ import Data.Attoparsec.Text ( ) import Data.Functor (($>)) import Data.Text (Text) -import Ledger (Address (addressCredential), Datum, Script (Script)) +import Ledger (Address (addressCredential), Datum) import Ledger.Ada qualified as Ada import Ledger.Scripts (DatumHash (..)) import Ledger.Tx (ChainIndexTxOut (PublicKeyChainIndexTxOut, ScriptChainIndexTxOut), TxId (..), TxOutRef (..)) import Ledger.Value (AssetClass, Value) import Ledger.Value qualified as Value -import Plutus.Script.Utils.Scripts qualified as Scripts +import Plutus.Script.Utils.Scripts qualified as ScriptUtils import Plutus.V1.Ledger.Api ( BuiltinByteString, Credential (PubKeyCredential, ScriptCredential), @@ -126,7 +126,7 @@ convertOutputDatum = \case -- FIXME" tmp implementation, check if something exists already NoOutputDatum -> Nothing OutputDatumHash dh -> Just (dh, Nothing) - OutputDatum d -> Just (Scripts.datumHash d, Just d) + OutputDatum d -> Just (ScriptUtils.datumHash d, Just d) -- TODO: Handle inline datums, if we need them here outputDatumParser :: Parser OutputDatum diff --git a/test/Spec.hs b/test/Spec.hs index 9fdd1372..93d61c52 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -3,15 +3,13 @@ module Main (main) where import Spec.BotPlutusInterface.AdjustUnbalanced qualified import Spec.BotPlutusInterface.Balance qualified import Spec.BotPlutusInterface.CoinSelection qualified -import Spec.BotPlutusInterface.Collateral qualified import Spec.BotPlutusInterface.Contract qualified import Spec.BotPlutusInterface.ContractStats qualified import Spec.BotPlutusInterface.Server qualified import Spec.BotPlutusInterface.TxStatusChange qualified import Spec.BotPlutusInterface.UtxoParser qualified -import Test.Tasty (TestTree, defaultMain, testGroup) -import Prelude import System.IO +import Test.Tasty (TestTree, defaultMain, testGroup) -- | @since 0.1 main :: IO () diff --git a/test/Spec/BotPlutusInterface/AdjustUnbalanced.hs b/test/Spec/BotPlutusInterface/AdjustUnbalanced.hs index 275bd49d..63ba98c5 100644 --- a/test/Spec/BotPlutusInterface/AdjustUnbalanced.hs +++ b/test/Spec/BotPlutusInterface/AdjustUnbalanced.hs @@ -18,7 +18,6 @@ import Ledger ( import Ledger.Ada qualified as Ada import Ledger.Constraints qualified as Constraints import Ledger.Tx (TxOutRef (TxOutRef)) -import Plutus.ChainIndex (OutputDatum (NoOutputDatum)) import Plutus.Contract ( Contract (..), Endpoint, diff --git a/test/Spec/BotPlutusInterface/Balance.hs b/test/Spec/BotPlutusInterface/Balance.hs index 179324fc..a917ab8e 100644 --- a/test/Spec/BotPlutusInterface/Balance.hs +++ b/test/Spec/BotPlutusInterface/Balance.hs @@ -5,7 +5,6 @@ import BotPlutusInterface.Balance qualified as Balance import BotPlutusInterface.Effects (PABEffect) import Data.Default (Default (def)) import Data.Map qualified as Map -import Data.Set qualified as Set import Data.Text qualified as Text import Ledger qualified import Ledger.Ada qualified as Ada diff --git a/test/Spec/BotPlutusInterface/Collateral.hs b/test/Spec/BotPlutusInterface/Collateral.hs index a68f077d..ecc3b40c 100644 --- a/test/Spec/BotPlutusInterface/Collateral.hs +++ b/test/Spec/BotPlutusInterface/Collateral.hs @@ -12,7 +12,7 @@ import Ledger qualified import Ledger.Ada qualified as Ada import Ledger.Constraints qualified as Constraints import Ledger.Scripts qualified as Scripts -import Ledger.Tx (CardanoTx, ChainIndexTxOut (PublicKeyChainIndexTxOut), TxOut (TxOut), TxOutRef (TxOutRef)) +import Ledger.Tx (CardanoTx, ChainIndexTxOut (PublicKeyChainIndexTxOut), TxOutRef (TxOutRef)) import Ledger.Tx qualified as Tx import Ledger.Tx qualified as TxId import Ledger.Value qualified as Value @@ -44,7 +44,6 @@ import Control.Concurrent.STM (newTVarIO) import Spec.BotPlutusInterface.Contract (assertCommandHistory, assertContract) -import Plutus.ChainIndex (OutputDatum (NoOutputDatum)) import PlutusTx qualified import PlutusTx.Builtins (fromBuiltin) import System.IO.Unsafe (unsafePerformIO) diff --git a/test/Spec/BotPlutusInterface/Config.hs b/test/Spec/BotPlutusInterface/Config.hs index 0f6d76aa..9f74259b 100644 --- a/test/Spec/BotPlutusInterface/Config.hs +++ b/test/Spec/BotPlutusInterface/Config.hs @@ -106,6 +106,7 @@ pabConfigExample = , protocolParamMaxValueSize = Just 1016 , protocolParamCollateralPercent = Just 1017 , protocolParamMaxCollateralInputs = Just 1018 + , protocolParamUTxOCostPerByte = Just 0 } , pcTipPollingInterval = 1021 , pcScriptFileDir = "./result-scripts2" diff --git a/test/Spec/BotPlutusInterface/Contract.hs b/test/Spec/BotPlutusInterface/Contract.hs index 43cb5ea7..921b9bcd 100644 --- a/test/Spec/BotPlutusInterface/Contract.hs +++ b/test/Spec/BotPlutusInterface/Contract.hs @@ -38,7 +38,6 @@ import Ledger.Tx ( import Ledger.Tx qualified as Tx import Ledger.Value qualified as Value import NeatInterpolation (text) -import Plutus.ChainIndex (OutputDatum (NoOutputDatum)) import Plutus.ChainIndex.Types (BlockId (..), Tip (..)) import Plutus.Contract ( Contract (..), @@ -83,7 +82,6 @@ import Spec.MockContract ( import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, testCase, (@?=)) import Prelude -import Plutus.Script.Utils.Scripts qualified as Scripts {- | Contract tests @@ -462,7 +460,7 @@ mintTokens = do curSymbol' = encodeByteString $ fromBuiltin $ Value.unCurrencySymbol curSymbol redeemerHash = - let (Scripts.RedeemerHash rh) = Scripts.redeemerHash Scripts.unitRedeemer + let (Scripts.RedeemerHash rh) = ScriptUtils.redeemerHash Scripts.unitRedeemer in encodeByteString $ fromBuiltin rh contract :: Contract () (Endpoint "SendAda" ()) Text CardanoTx @@ -553,7 +551,7 @@ spendToValidator = do datum = Scripts.Datum $ PlutusTx.toBuiltinData (11 :: Integer) datumHash :: ScriptUtils.DatumHash - datumHash = Scripts.datumHash datum + datumHash = ScriptUtils.datumHash datum datumHash' = let (Scripts.DatumHash dh) = datumHash @@ -644,14 +642,14 @@ redeemFromValidator = do datum = Scripts.Datum $ PlutusTx.toBuiltinData (11 :: Integer) datumHash :: Scripts.DatumHash - datumHash = Scripts.datumHash datum + datumHash = ScriptUtils.datumHash datum datumHash' = let (Scripts.DatumHash dh) = datumHash in encodeByteString $ fromBuiltin dh redeemerHash = - let (Scripts.RedeemerHash rh) = Scripts.redeemerHash Scripts.unitRedeemer + let (Scripts.RedeemerHash rh) = ScriptUtils.redeemerHash Scripts.unitRedeemer in encodeByteString $ fromBuiltin rh contract :: Contract () (Endpoint "SendAda" ()) Text CardanoTx diff --git a/test/Spec/BotPlutusInterface/ContractStats.hs b/test/Spec/BotPlutusInterface/ContractStats.hs index 1a5da85a..dea7b9dd 100644 --- a/test/Spec/BotPlutusInterface/ContractStats.hs +++ b/test/Spec/BotPlutusInterface/ContractStats.hs @@ -12,7 +12,6 @@ import Ledger (ChainIndexTxOut (PublicKeyChainIndexTxOut), PaymentPubKeyHash (un import Ledger.Ada qualified as Ada import Ledger.Constraints qualified as Constraints import Ledger.Tx (CardanoTx, TxOutRef (TxOutRef)) -import Plutus.ChainIndex (OutputDatum (NoOutputDatum)) import Plutus.Contract ( Contract (..), Endpoint, diff --git a/test/Spec/BotPlutusInterface/TxStatusChange.hs b/test/Spec/BotPlutusInterface/TxStatusChange.hs index 009ae546..38fd007d 100644 --- a/test/Spec/BotPlutusInterface/TxStatusChange.hs +++ b/test/Spec/BotPlutusInterface/TxStatusChange.hs @@ -13,7 +13,7 @@ import Ledger (ChainIndexTxOut (PublicKeyChainIndexTxOut), PaymentPubKeyHash (un import Ledger.Ada qualified as Ada import Ledger.Constraints qualified as Constraints import Ledger.Tx (TxOutRef (TxOutRef)) -import Plutus.ChainIndex (OutputDatum (NoOutputDatum), RollbackState (Unknown), Tip (TipAtGenesis), TxStatus) +import Plutus.ChainIndex (RollbackState (Unknown), Tip (TipAtGenesis), TxStatus) import Plutus.ChainIndex.Types (Tip (Tip)) import Plutus.Contract ( Contract (..), diff --git a/test/Spec/BotPlutusInterface/UtxoParser.hs b/test/Spec/BotPlutusInterface/UtxoParser.hs index eb0471b5..ecc62d16 100644 --- a/test/Spec/BotPlutusInterface/UtxoParser.hs +++ b/test/Spec/BotPlutusInterface/UtxoParser.hs @@ -18,7 +18,6 @@ import Ledger.Tx ( import Ledger.Value (TokenName (TokenName)) import Ledger.Value qualified as Value import NeatInterpolation (text) -import Plutus.V2.Ledger.Api (OutputDatum (NoOutputDatum, OutputDatumHash)) import PlutusTx.Builtins (toBuiltin) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (Assertion, testCase, (@?=)) diff --git a/test/Spec/MockContract.hs b/test/Spec/MockContract.hs index c7d7f291..dad89980 100644 --- a/test/Spec/MockContract.hs +++ b/test/Spec/MockContract.hs @@ -125,7 +125,6 @@ import Data.Text.Encoding (decodeUtf8) import Data.Tuple.Extra (first) import Data.UUID qualified as UUID import GHC.IO.Exception (IOErrorType (NoSuchThing), IOException (IOError)) -import Plutus.Script.Utils.Scripts qualified as Scripts import Ledger ( Extended (NegInf, PosInf), Interval (Interval), @@ -495,7 +494,7 @@ txOutToDatum :: ChainIndexTxOut -> Text txOutToDatum = \case PublicKeyChainIndexTxOut _ _ Nothing _ -> "TxOutDatumNone" - PublicKeyChainIndexTxOut _ _ (Just (dh, Nothing)) _ -> printDatumHash dh + PublicKeyChainIndexTxOut _ _ (Just (dh, Nothing)) _ -> printDatumHash dh PublicKeyChainIndexTxOut _ _ (Just (_, Just (Datum d))) _ -> printDatum d ScriptChainIndexTxOut _ _ (dh, Nothing) _ _ -> printDatumHash dh ScriptChainIndexTxOut _ _ (_, Just (Datum d)) _ _ -> printDatum d @@ -712,11 +711,11 @@ converCiTxOut (ScriptChainIndexTxOut addr val eitherDatum maybeRefSc _) = (_, Just d) -> OutputDatum d in CIT.ChainIndexTxOut addr val datum (convertRefScript maybeRefSc) -convertMaybeDatum :: Maybe (DatumHash, Maybe Datum) -> OutputDatum +convertMaybeDatum :: Maybe (DatumHash, Maybe Datum) -> OutputDatum convertMaybeDatum = \case -- FIXME" tmp implementation, check if something exists already for such conversion - Nothing -> NoOutputDatum - Just (dh, Nothing) -> OutputDatumHash dh + Nothing -> NoOutputDatum + Just (dh, Nothing) -> OutputDatumHash dh Just (_dh, Just d) -> OutputDatum d convertRefScript :: Maybe V1.Script -> ReferenceScript From 1ded6c3b67ee7be0967201e9dffc69c2bb1d830f Mon Sep 17 00:00:00 2001 From: Mikhail Lazarev Date: Thu, 18 Aug 2022 09:39:58 +0300 Subject: [PATCH 3/4] fixme about datum parser --- src/BotPlutusInterface/UtxoParser.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/BotPlutusInterface/UtxoParser.hs b/src/BotPlutusInterface/UtxoParser.hs index 20439294..23cf2d80 100644 --- a/src/BotPlutusInterface/UtxoParser.hs +++ b/src/BotPlutusInterface/UtxoParser.hs @@ -123,7 +123,6 @@ tokenNameParser = do convertOutputDatum :: OutputDatum -> Maybe (DatumHash, Maybe Datum) convertOutputDatum = \case - -- FIXME" tmp implementation, check if something exists already NoOutputDatum -> Nothing OutputDatumHash dh -> Just (dh, Nothing) OutputDatum d -> Just (ScriptUtils.datumHash d, Just d) @@ -133,7 +132,7 @@ outputDatumParser :: Parser OutputDatum outputDatumParser = OutputDatumHash <$> datumHashParser <|> "TxOutDatumNone" $> NoOutputDatum - <|> "OutputDatum" $> error "OutputDatum not supported yet" -- FIXME: some better handling + -- FIXME: will it fail for "TxOutDatumInline ..."? datumHashParser :: Parser DatumHash datumHashParser = do From 2fc77d68d3848e3fcdb237017ea2525d107b22d7 Mon Sep 17 00:00:00 2001 From: Mikhail Lazarev Date: Thu, 18 Aug 2022 09:47:22 +0300 Subject: [PATCH 4/4] fix formatting --- src/BotPlutusInterface/UtxoParser.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/BotPlutusInterface/UtxoParser.hs b/src/BotPlutusInterface/UtxoParser.hs index 23cf2d80..d202c1cd 100644 --- a/src/BotPlutusInterface/UtxoParser.hs +++ b/src/BotPlutusInterface/UtxoParser.hs @@ -132,7 +132,8 @@ outputDatumParser :: Parser OutputDatum outputDatumParser = OutputDatumHash <$> datumHashParser <|> "TxOutDatumNone" $> NoOutputDatum - -- FIXME: will it fail for "TxOutDatumInline ..."? + +-- FIXME: will it fail for "TxOutDatumInline ..."? datumHashParser :: Parser DatumHash datumHashParser = do