Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions bot-plutus-interface.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -85,6 +85,7 @@ library
BotPlutusInterface.Types
BotPlutusInterface.UtxoParser
BotPlutusInterface.Server
BotPlutusInterface.Helpers
build-depends:
, aeson ^>=1.5.0.0
, attoparsec >=0.13.2.2
Expand Down
3 changes: 2 additions & 1 deletion examples/plutus-game/app/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -61,13 +61,14 @@ main = do
, pcTipPollingInterval = 10_000_000
, pcSlotConfig = def
, pcOwnPubKeyHash = "0f45aaf1b2959db6e5ff94dbb1f823bf257680c3c723ac2d49f97546"
, pcOwnStakePubKeyHash = Nothing
, pcScriptFileDir = "./scripts"
, pcSigningKeyFileDir = "./signing-keys"
, pcTxFileDir = "./txs"
, pcDryRun = True
, pcLogLevel = Debug
, pcProtocolParamsFile = "./protocol.json"
, pcForceBudget = Just (1000, 1000)
, pcForceBudget = Just (9_000_000_000, 15_000_000)
, pcEnableTxEndpoint = True
}
BotPlutusInterface.runPAB @GameContracts pabConf
2 changes: 1 addition & 1 deletion examples/plutus-game/guess.sh
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@ CONTRACT_INST_ID=$(curl --location --request POST 'localhost:9080/api/contract/a
"caID": {
"tag": "Guess",
"contents": {
"guessGameId": 2,
"guessGameId": 3,
"guessSecret": "secret"
}
}
Expand Down
2 changes: 1 addition & 1 deletion examples/plutus-game/lock.sh
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@ CONTRACT_INST_ID=$(curl --location --request POST 'localhost:9080/api/contract/a
"caID": {
"tag": "Lock",
"contents": {
"lockGameId": 2,
"lockGameId": 3,
"lockAmount": 1000000,
"lockSecret": "secret"
}
Expand Down
1 change: 1 addition & 0 deletions examples/plutus-game/plutus-game.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -81,6 +81,7 @@ library
, cardano-crypto
, cardano-ledger-alonzo
, containers
, bot-plutus-interface
, data-default
, data-default-class
, directory
Expand Down
338 changes: 169 additions & 169 deletions examples/plutus-game/protocol.json

Large diffs are not rendered by default.

1 change: 1 addition & 0 deletions examples/plutus-nft/app/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -61,6 +61,7 @@ main = do
, pcTipPollingInterval = 10_000_000
, pcSlotConfig = def
, pcOwnPubKeyHash = "0f45aaf1b2959db6e5ff94dbb1f823bf257680c3c723ac2d49f97546"
, pcOwnStakePubKeyHash = Nothing
, pcScriptFileDir = "./scripts"
, pcSigningKeyFileDir = "./signing-keys"
, pcTxFileDir = "./txs"
Expand Down
1 change: 1 addition & 0 deletions examples/plutus-transfer/app/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -60,6 +60,7 @@ main = do
, pcTipPollingInterval = 10_000_000
, pcSlotConfig = def
, pcOwnPubKeyHash = "0f45aaf1b2959db6e5ff94dbb1f823bf257680c3c723ac2d49f97546"
, pcOwnStakePubKeyHash = Nothing
, pcScriptFileDir = "./scripts"
, pcSigningKeyFileDir = "./signing-keys"
, pcTxFileDir = "./txs"
Expand Down
46 changes: 21 additions & 25 deletions src/BotPlutusInterface/Balance.hs
Original file line number Diff line number Diff line change
Expand Up @@ -73,7 +73,7 @@ balanceTxIO ::
balanceTxIO pabConf ownPkh unbalancedTx =
runEitherT $
do
utxos <- newEitherT $ CardanoCLI.utxosAt @w pabConf $ Ledger.pubKeyHashAddress (Ledger.PaymentPubKeyHash ownPkh) Nothing
utxos <- newEitherT $ CardanoCLI.utxosAt @w pabConf changeAddr
privKeys <- newEitherT $ Files.readPrivateKeys @w pabConf
let utxoIndex = fmap Tx.toTxOut utxos <> unBalancedTxUtxoIndex unbalancedTx
requiredSigs = map Ledger.unPaymentPubKeyHash $ Map.keys (unBalancedTxRequiredSignatories unbalancedTx)
Expand Down Expand Up @@ -101,17 +101,19 @@ balanceTxIO pabConf ownPkh unbalancedTx =
-- If we have change but no change UTxO, we need to add an output for it
-- We'll add a minimal output, run the loop again so it gets minUTxO, then update change
balancedTxWithChange <-
if adaChange /= 0 && not (hasChangeUTxO ownPkh balancedTx)
then fst <$> loop utxoIndex privKeys minUtxos (addOutput ownPkh balancedTx)
if adaChange /= 0 && not (hasChangeUTxO changeAddr balancedTx)
then fst <$> loop utxoIndex privKeys minUtxos (addOutput changeAddr balancedTx)
else pure balancedTx

-- Get the updated change, add it to the tx
let finalAdaChange = getAdaChange utxoIndex balancedTxWithChange
fullyBalancedTx = addAdaChange ownPkh finalAdaChange balancedTxWithChange
fullyBalancedTx = addAdaChange changeAddr finalAdaChange balancedTxWithChange

-- finally, we must update the signatories
hoistEither $ addSignatories ownPkh privKeys requiredSigs fullyBalancedTx
where
changeAddr :: Address
changeAddr = Ledger.pubKeyHashAddress (Ledger.PaymentPubKeyHash ownPkh) (pabConf.pcOwnStakePubKeyHash)
loop ::
Map TxOutRef TxOut ->
Map PubKeyHash DummyPrivKey ->
Expand All @@ -130,7 +132,7 @@ balanceTxIO pabConf ownPkh unbalancedTx =

-- Calculate fees by pre-balancing the tx, building it, and running the CLI on result
txWithoutFees <-
hoistEither $ balanceTxStep minUtxos utxoIndex ownPkh $ tx `withFee` 0
hoistEither $ balanceTxStep minUtxos utxoIndex changeAddr $ tx `withFee` 0

exBudget <- newEitherT $ CardanoCLI.buildTx @w pabConf privKeys txWithoutFees
nonBudgettedFees <- newEitherT $ CardanoCLI.calculateMinFee @w pabConf txWithoutFees
Expand All @@ -140,7 +142,7 @@ balanceTxIO pabConf ownPkh unbalancedTx =
lift $ printLog @w Debug $ "Fees: " ++ show fees

-- Rebalance the initial tx with the above fees
balancedTx <- hoistEither $ balanceTxStep minUtxos utxoIndex ownPkh $ tx `withFee` fees
balancedTx <- hoistEither $ balanceTxStep minUtxos utxoIndex changeAddr $ tx `withFee` fees

if balancedTx == tx
then pure (balancedTx, minUtxos)
Expand Down Expand Up @@ -175,13 +177,13 @@ calculateMinUtxos pabConf datums txOuts =
balanceTxStep ::
[(TxOut, Integer)] ->
Map TxOutRef TxOut ->
PubKeyHash ->
Address ->
Tx ->
Either Text Tx
balanceTxStep minUtxos utxos ownPkh tx =
balanceTxStep minUtxos utxos changeAddr tx =
Right (addLovelaces minUtxos tx)
>>= balanceTxIns utxos
>>= handleNonAdaChange ownPkh utxos
>>= handleNonAdaChange changeAddr utxos

-- | Get change value of a transaction, taking inputs, outputs, mint and fees into account
getChange :: Map TxOutRef TxOut -> Tx -> Value
Expand Down Expand Up @@ -288,10 +290,9 @@ addTxCollaterals utxos tx = do
filterAdaOnly = Map.filter (isAdaOnly . txOutValue)

-- | Ensures all non ada change goes back to user
handleNonAdaChange :: PubKeyHash -> Map TxOutRef TxOut -> Tx -> Either Text Tx
handleNonAdaChange ownPkh utxos tx =
let changeAddr = Ledger.pubKeyHashAddress (Ledger.PaymentPubKeyHash ownPkh) Nothing
nonAdaChange = getNonAdaChange utxos tx
handleNonAdaChange :: Address -> Map TxOutRef TxOut -> Tx -> Either Text Tx
handleNonAdaChange changeAddr utxos tx =
let nonAdaChange = getNonAdaChange utxos tx
outputs =
case partition ((==) changeAddr . Tx.txOutAddress) $ txOutputs tx of
([], txOuts) ->
Expand All @@ -307,38 +308,33 @@ handleNonAdaChange ownPkh utxos tx =
then Right $ if Value.isZero nonAdaChange then tx else tx {txOutputs = outputs}
else Left "Not enough inputs to balance tokens."

hasChangeUTxO :: PubKeyHash -> Tx -> Bool
hasChangeUTxO ownPkh tx =
hasChangeUTxO :: Address -> Tx -> Bool
hasChangeUTxO changeAddr tx =
any ((==) changeAddr . Tx.txOutAddress) $ txOutputs tx
where
changeAddr = Ledger.pubKeyHashAddress (Ledger.PaymentPubKeyHash ownPkh) Nothing

-- | Adds ada change to a transaction, assuming there is already an output going to ownPkh. Otherwise, this is identity
addAdaChange :: PubKeyHash -> Integer -> Tx -> Tx
addAdaChange ownPkh change tx =
addAdaChange :: Address -> Integer -> Tx -> Tx
addAdaChange changeAddr change tx =
tx
{ txOutputs =
case partition ((==) changeAddr . Tx.txOutAddress) $ txOutputs tx of
(txOut@TxOut {txOutValue = v} : txOuts, txOuts') ->
txOut {txOutValue = v <> Ada.lovelaceValueOf change} : (txOuts <> txOuts')
_ -> txOutputs tx
}
where
changeAddr = Ledger.pubKeyHashAddress (Ledger.PaymentPubKeyHash ownPkh) Nothing

-- | Adds a 1 lovelace output to a transaction
addOutput :: PubKeyHash -> Tx -> Tx
addOutput ownPkh tx = tx {txOutputs = changeTxOut : txOutputs tx}
addOutput :: Address -> Tx -> Tx
addOutput changeAddr tx = tx {txOutputs = changeTxOut : txOutputs tx}
where
changeAddr = Ledger.pubKeyHashAddress (Ledger.PaymentPubKeyHash ownPkh) Nothing
changeTxOut =
TxOut
{ txOutAddress = changeAddr
, txOutValue = Ada.lovelaceValueOf 1
, txOutDatumHash = Nothing
}

{- | Add the required signatorioes to the transaction. Be aware the the signature itself is invalid,
{- | Add the required signatories to the transaction. Be aware the the signature itself is invalid,
and will be ignored. Only the pub key hashes are used, mapped to signing key files on disk.
-}
addSignatories :: PubKeyHash -> Map PubKeyHash DummyPrivKey -> [PubKeyHash] -> Tx -> Either Text Tx
Expand Down
15 changes: 8 additions & 7 deletions src/BotPlutusInterface/CardanoCLI.hs
Original file line number Diff line number Diff line change
Expand Up @@ -76,6 +76,7 @@ import Ledger.Tx (
TxInType (..),
TxOut (..),
TxOutRef (..),
txId,
)
import Ledger.TxId (TxId (..))
import Ledger.Value (Value)
Expand Down Expand Up @@ -176,7 +177,7 @@ calculateMinFee pabConf tx =
, cmdArgs =
mconcat
[ ["transaction", "calculate-min-fee"]
, ["--tx-body-file", txFilePath pabConf "raw" tx]
, ["--tx-body-file", txFilePath pabConf "raw" (txId tx)]
, ["--tx-in-count", showText $ length $ txInputs tx]
, ["--tx-out-count", showText $ length $ txOutputs tx]
, ["--witness-count", showText $ length $ txSignatures tx]
Expand Down Expand Up @@ -295,7 +296,7 @@ buildTx pabConf privKeys tx = do
, ["--fee", showText . getLovelace . fromValue $ txFee tx]
, mconcat
[ ["--protocol-params-file", pabConf.pcProtocolParamsFile]
, ["--out-file", txFilePath pabConf "raw" tx]
, ["--out-file", txFilePath pabConf "raw" (txId tx)]
]
]

Expand All @@ -318,9 +319,9 @@ signTx pabConf tx pubKeys =
opts =
mconcat
[ ["transaction", "sign"]
, ["--tx-body-file", txFilePath pabConf "raw" tx]
, ["--tx-body-file", txFilePath pabConf "raw" (txId tx)]
, signingKeyFiles
, ["--out-file", txFilePath pabConf "signed" tx]
, ["--out-file", txFilePath pabConf "signed" (txId tx)]
]

budgetFromConfig :: PABConfig -> ExBudget -> ExBudget
Expand All @@ -343,7 +344,7 @@ submitTx pabConf tx =
"cardano-cli"
( mconcat
[ ["transaction", "submit"]
, ["--tx-file", txFilePath pabConf "signed" tx]
, ["--tx-file", txFilePath pabConf "signed" (txId tx)]
, networkOpt pabConf
]
)
Expand Down Expand Up @@ -480,8 +481,8 @@ networkOpt pabConf = case pabConf.pcNetwork of
Mainnet -> ["--mainnet"]

txOutRefToCliArg :: TxOutRef -> Text
txOutRefToCliArg (TxOutRef (TxId txId) txIx) =
encodeByteString (fromBuiltin txId) <> "#" <> showText txIx
txOutRefToCliArg (TxOutRef (TxId tId) txIx) =
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

[nits] I think there's a typo here

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Had to rename that because we are importing txId from Ledger.Tx

encodeByteString (fromBuiltin tId) <> "#" <> showText txIx

flatValueToCliArg :: (CurrencySymbol, TokenName, Integer) -> Text
flatValueToCliArg (curSymbol, name, amount)
Expand Down
Loading