Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Use reference input #4114

Merged
merged 19 commits into from
Sep 18, 2023
Merged

Use reference input #4114

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
19 commits
Select commit Hold shift + click to select a range
e882a08
add required policy id in request when usin reference scripts
paweljakubas Aug 23, 2023
36099ee
update spec for policy_id
paweljakubas Aug 25, 2023
9dde814
refactor parseMintBurnData
paweljakubas Aug 28, 2023
9f1fa52
refactor constructTransaction - part 1
paweljakubas Aug 29, 2023
e2d91a5
fix toMintTxOut
paweljakubas Aug 30, 2023
226f282
introduce ScriptSource
paweljakubas Aug 30, 2023
fb1de7e
adjust rest code in constructTransactin
paweljakubas Aug 30, 2023
3bf9526
adjust mkUnsignedTx
paweljakubas Aug 31, 2023
f17c4e9
integration test - part 1
paweljakubas Aug 31, 2023
a56f8f9
integration test - part 2
paweljakubas Aug 31, 2023
98e975a
integration test - part 3
paweljakubas Sep 1, 2023
40fbec7
use SReferenceScript
paweljakubas Sep 5, 2023
3460a9b
add policy key witness when referencing
paweljakubas Sep 5, 2023
3d77adc
adjust estimateWitsCount plus cleaning
paweljakubas Sep 5, 2023
6ee90b1
final prove minting from reference inputs works
paweljakubas Sep 5, 2023
75323da
show burning using reference inputs
paweljakubas Sep 7, 2023
5953e52
reference input witness count fix
paweljakubas Sep 13, 2023
15db0b2
adopt Heinrich suggestion
paweljakubas Sep 15, 2023
9498a85
use getTransaction instead of getTransaction
paweljakubas Sep 15, 2023
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
14 changes: 13 additions & 1 deletion lib/balance-tx/lib/Cardano/Wallet/Write/Tx/Sign.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -188,12 +188,24 @@ estimateKeyWitnessCount utxo txbody@(Cardano.TxBody txbodycontent) =
fromIntegral
$ sumVia estimateMaxWitnessRequiredPerInput
$ mapMaybe toTimelockScript scripts
-- when wallets uses reference input it means script containing
-- its policy key was already published in previous tx
-- if so we need to add one witness that will stem from policy signing
-- key. As it is not allowed to publish and consume in the same transaction
-- we are not going to double count.
txRefInpsWit = case Cardano.txInsReference txbodycontent of
Cardano.TxInsReferenceNone -> 0
Cardano.TxInsReference{} ->
case Cardano.txMintValue txbodycontent of
Cardano.TxMintNone -> 0
Cardano.TxMintValue{} -> 1
nonInputWits = numberOfShelleyWitnesses $ fromIntegral $
length txExtraKeyWits' +
length txWithdrawals' +
txUpdateProposal' +
fromIntegral txCerts +
scriptVkWitsUpperBound
scriptVkWitsUpperBound +
txRefInpsWit
inputWits = KeyWitnessCount
{ nKeyWits = fromIntegral
. length
Expand Down
188 changes: 113 additions & 75 deletions lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -313,6 +313,7 @@ import Cardano.Wallet.Api.Types
, ApiForeignStakeKey (..)
, ApiIncompleteSharedWallet (..)
, ApiMintBurnData (..)
, ApiMintBurnDataFromInput (..)
, ApiMintBurnDataFromScript (..)
, ApiMintBurnOperation (..)
, ApiMintData (..)
Expand Down Expand Up @@ -591,7 +592,7 @@ import Data.Coerce
import Data.Either
( isLeft, isRight )
import Data.Either.Extra
( eitherToMaybe, fromLeft' )
( eitherToMaybe )
import Data.Function
( (&) )
import Data.Functor
Expand Down Expand Up @@ -2449,7 +2450,7 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d
validityInterval <-
liftHandler $ parseValidityInterval ti $ body ^. #validityInterval

mintBurnData <-
mintBurnDatum <-
liftHandler $ except $ parseMintBurnData body validityInterval

mintBurnReferenceScriptTemplate <-
Expand Down Expand Up @@ -2501,47 +2502,65 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d
liftHandler $ W.readPolicyPublicKey wrk

transactionCtx2 <-
if isJust mintBurnData then do
let isMinting (ApiMintBurnDataFromScript _ _ (ApiMint _)) = True
isMinting _ = False
let getMinting = \case
ApiMintBurnDataFromScript
if isJust mintBurnDatum then do
let isMinting mb = case mb ^. #mintBurnData of
Left (ApiMintBurnDataFromScript _ _ (ApiMint _)) -> True
Right (ApiMintBurnDataFromInput _ _ _ (ApiMint _)) -> True
_ -> False

makeLeft (a,t,s) = (a,t, Left s)
getMinting mb = case mb ^. #mintBurnData of
Left (ApiMintBurnDataFromScript
(ApiT scriptT)
(Just (ApiT tName))
(ApiMint (ApiMintData _ amt)) ->
(ApiMint (ApiMintData _ amt))) ->
makeLeft $
toTokenMapAndScript ShelleyKeyS
scriptT
(Map.singleton (Cosigner 0) policyXPub)
tName
amt
Right (ApiMintBurnDataFromInput
refInp
(ApiT policyId)
(Just (ApiT tName))
(ApiMint (ApiMintData _ amt))) ->
(AssetId policyId tName, TokenQuantity amt, Right refInp)
_ -> error "getMinting should not be used in this way"
let getBurning = \case
ApiMintBurnDataFromScript
getBurning mb = case mb ^. #mintBurnData of
Left (ApiMintBurnDataFromScript
(ApiT scriptT)
(Just (ApiT tName))
(ApiBurn (ApiBurnData amt)) ->
(ApiBurn (ApiBurnData amt))) ->
makeLeft $
toTokenMapAndScript ShelleyKeyS
scriptT
(Map.singleton (Cosigner 0) policyXPub)
tName
amt
Right (ApiMintBurnDataFromInput
refInp
(ApiT policyId)
(Just (ApiT tName))
(ApiBurn (ApiBurnData amt))) ->
(AssetId policyId tName, TokenQuantity amt, Right refInp)
_ -> error "getBurning should not be used in this way"
let toTokenMap =
toTokenMap =
fromFlatList .
map (\(a,q,_) -> (a,q))
let toScriptTemplateMap =
toScriptTemplateMap =
Map.fromList .
map (\(a,_,s) -> (a,s))
let mintingData =
mintingData =
toTokenMap &&& toScriptTemplateMap $
map getMinting $
filter isMinting $
NE.toList $ fromJust mintBurnData
let burningData =
NE.toList $ fromJust mintBurnDatum
burningData =
toTokenMap &&& toScriptTemplateMap $
map getBurning $
filter (not . isMinting) $
NE.toList $ fromJust mintBurnData
NE.toList $ fromJust mintBurnDatum
pure transactionCtx1
{ txAssetsToMint = mintingData
, txAssetsToBurn = burningData
Expand All @@ -2564,11 +2583,13 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d
Just (ApiPaymentAddresses content) ->
pure $ F.toList (addressAmountToTxOut <$> content)

let mintWithAddress
(ApiMintBurnDataFromScript _ _ (ApiMint (ApiMintData (Just _) _)))
= True
mintWithAddress _ = False
let mintingOuts = case mintBurnData of
let mintWithAddress mb = case mb ^. #mintBurnData of
Left (ApiMintBurnDataFromScript _ _ (ApiMint (ApiMintData (Just _) _))) ->
True
Right (ApiMintBurnDataFromInput _ _ _ (ApiMint (ApiMintData (Just _) _))) ->
True
_ -> False
let mintingOuts = case mintBurnDatum of
Just mintBurns ->
coalesceTokensPerAddr $
map (toMintTxOut policyXPub) $
Expand Down Expand Up @@ -2648,83 +2669,93 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d
parseMintBurnData
:: ApiConstructTransactionData n
-> (SlotNo, SlotNo)
-> Either ErrConstructTx (Maybe (NonEmpty (ApiMintBurnDataFromScript n)))
-> Either ErrConstructTx (Maybe (NonEmpty (ApiMintBurnData n)))
parseMintBurnData tx validity = do
when (notAllFromScript (tx ^. #mintBurn)) $
Left ErrConstructTxNotImplemented
let mbMintingBurning :: Maybe (NonEmpty (ApiMintBurnDataFromScript n))
let mbMintingBurning :: Maybe (NonEmpty (ApiMintBurnData n))
mbMintingBurning =
fmap (handleMissingAssetName . takeMintingFromScript)
<$> tx ^. #mintBurn
fmap handleMissingAssetName <$> tx ^. #mintBurn
for mbMintingBurning $ \mintBurnData -> do
guardWrongMintingTemplate mintBurnData
guardAssetNameTooLong mintBurnData
guardAssetQuantityOutOfBounds mintBurnData
guardOutsideValidityInterval validity mintBurnData
Right mintBurnData
where
notAllFromScript = \case
Nothing -> False
Just mintData ->
any isRight $ mintBurnData <$> NE.toList mintData

-- we checked that only left are present in preceding line
takeMintingFromScript (ApiMintBurnData mintData) =
fromLeft' mintData

handleMissingAssetName :: ApiMintBurnDataFromScript n -> ApiMintBurnDataFromScript n
handleMissingAssetName mb = case mb ^. #assetName of
Nothing -> mb {assetName = Just (ApiT nullTokenName)}
Just _ -> mb
handleMissingAssetName :: ApiMintBurnData n -> ApiMintBurnData n
handleMissingAssetName mb = case mb ^. #mintBurnData of
Left fromScript -> ApiMintBurnData $ Left $
updateFromScript fromScript
Right fromInp -> ApiMintBurnData $ Right $
updateFromInp fromInp
where
updateFromScript :: ApiMintBurnDataFromScript n -> ApiMintBurnDataFromScript n
updateFromScript mbd = case mbd ^. #assetName of
Nothing -> mbd {assetName = Just (ApiT nullTokenName)}
Just _ -> mbd
updateFromInp :: ApiMintBurnDataFromInput n -> ApiMintBurnDataFromInput n
updateFromInp mbd = case mbd ^. #assetName of
Nothing -> mbd {assetName = Just (ApiT nullTokenName)}
Just _ -> mbd

guardWrongMintingTemplate
:: NonEmpty (ApiMintBurnDataFromScript n) -> Either ErrConstructTx ()
guardWrongMintingTemplate mintBurnData =
when (any wrongMintingTemplate mintBurnData)
:: NonEmpty (ApiMintBurnData n) -> Either ErrConstructTx ()
guardWrongMintingTemplate mbs =
when (any wrongMintingTemplate mbs)
$ Left ErrConstructTxWrongMintingBurningTemplate
where
wrongMintingTemplate (ApiMintBurnDataFromScript (ApiT script) _ _) =
isLeft (validateScriptOfTemplate RecommendedValidation script)
|| countCosigners script /= (1 :: Int)
|| existsNonZeroCosigner script
wrongMintingTemplate mb = case mb ^. #mintBurnData of
Left (ApiMintBurnDataFromScript (ApiT script) _ _) ->
isLeft (validateScriptOfTemplate RecommendedValidation script)
|| countCosigners script /= (1 :: Int)
|| existsNonZeroCosigner script
Right (ApiMintBurnDataFromInput _ _ _ _) -> False
countCosigners = foldScript (const (+ 1)) 0
existsNonZeroCosigner =
foldScript (\cosigner a -> a || cosigner /= Cosigner 0) False

guardAssetNameTooLong
:: NonEmpty (ApiMintBurnDataFromScript n) -> Either ErrConstructTx ()
guardAssetNameTooLong mintBurnData =
when (any assetNameTooLong mintBurnData)
$ Left ErrConstructTxAssetNameTooLong
:: NonEmpty (ApiMintBurnData n) -> Either ErrConstructTx ()
guardAssetNameTooLong mbs =
when (any assetNameTooLong mbs)$ Left ErrConstructTxAssetNameTooLong
where
assetNameTooLong = \case
ApiMintBurnDataFromScript _ (Just (ApiT (UnsafeTokenName bs))) _ ->
assetNameTooLong mb = case mb ^. #mintBurnData of
Left (ApiMintBurnDataFromScript _ (Just (ApiT (UnsafeTokenName bs))) _) ->
BS.length bs > tokenNameMaxLength
Right (ApiMintBurnDataFromInput _ _ (Just (ApiT (UnsafeTokenName bs))) _) ->
BS.length bs > tokenNameMaxLength
_ -> error "tokenName should be nonempty at this step"
_ -> error "at this moment there should be asset name attributed"

guardAssetQuantityOutOfBounds
:: NonEmpty (ApiMintBurnDataFromScript n) -> Either ErrConstructTx ()
guardAssetQuantityOutOfBounds mintBurnData =
when (any assetQuantityOutOfBounds mintBurnData)
:: NonEmpty (ApiMintBurnData n) -> Either ErrConstructTx ()
guardAssetQuantityOutOfBounds mbs =
when (any assetQuantityOutOfBounds mbs)
$ Left ErrConstructTxMintOrBurnAssetQuantityOutOfBounds
where
assetQuantityOutOfBounds = \case
ApiMintBurnDataFromScript _ _ (ApiMint (ApiMintData _ amt)) ->
amt <= 0 || amt > unTokenQuantity txMintBurnMaxTokenQuantity
ApiMintBurnDataFromScript _ _ (ApiBurn (ApiBurnData amt)) ->
amt <= 0 || amt > unTokenQuantity txMintBurnMaxTokenQuantity
checkAmt amt =
amt <= 0 || amt > unTokenQuantity txMintBurnMaxTokenQuantity
assetQuantityOutOfBounds mb = case mb ^. #mintBurnData of
Left (ApiMintBurnDataFromScript _ _ (ApiMint (ApiMintData _ amt))) ->
checkAmt amt
Left (ApiMintBurnDataFromScript _ _ (ApiBurn (ApiBurnData amt))) ->
checkAmt amt
Right (ApiMintBurnDataFromInput _ _ _ (ApiMint (ApiMintData _ amt))) ->
checkAmt amt
Right (ApiMintBurnDataFromInput _ _ _ (ApiBurn (ApiBurnData amt))) ->
checkAmt amt

guardOutsideValidityInterval
:: (SlotNo, SlotNo)
-> NonEmpty (ApiMintBurnDataFromScript n)
-> NonEmpty (ApiMintBurnData n)
-> Either ErrConstructTx ()
guardOutsideValidityInterval (before, hereafter) mintBurnData =
when (any notWithinValidityInterval mintBurnData) $
guardOutsideValidityInterval (before, hereafter) mbs =
when (any notWithinValidityInterval mbs) $
Left ErrConstructTxValidityIntervalNotWithinScriptTimelock
where
notWithinValidityInterval (ApiMintBurnDataFromScript (ApiT script) _ _) =
not $ withinSlotInterval before hereafter $
notWithinValidityInterval mb = case mb ^. #mintBurnData of
Left (ApiMintBurnDataFromScript (ApiT script) _ _) ->
not $ withinSlotInterval before hereafter $
scriptSlotIntervals script
Right _ -> False

unsignedTx path initialOuts decodedTx = UnsignedTx
{ unsignedCollateral =
Expand All @@ -2747,20 +2778,27 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d
mapMaybe (toUsignedTxWdrl path) (decodedTx ^. #withdrawals)
}

toMintTxOut policyXPub
(ApiMintBurnDataFromScript (ApiT scriptT) (Just (ApiT tName))
(ApiMint (ApiMintData (Just addr) amt))) =
toMintTxOut policyXPub mb = case mb ^. #mintBurnData of
Left (ApiMintBurnDataFromScript (ApiT scriptT) (Just (ApiT tName))
(ApiMint (ApiMintData (Just addr) amt))) ->
let (assetId, tokenQuantity, _) =
toTokenMapAndScript ShelleyKeyS
scriptT (Map.singleton (Cosigner 0) policyXPub)
tName amt
assets = fromFlatList [(assetId, tokenQuantity)]
in
(addr, assets)
toMintTxOut _ _ = error $ unwords
[ "toMintTxOut can only be used in the minting context with addr"
, "specified"
]
Right (ApiMintBurnDataFromInput _ (ApiT policyId) (Just (ApiT tName))
(ApiMint (ApiMintData (Just addr) amt))) ->
let assetId = AssetId policyId tName
tokenQuantity = TokenQuantity amt
assets = fromFlatList [(assetId, tokenQuantity)]
in
(addr, assets)
_ -> error $ unwords
[ "toMintTxOut can only be used in the minting context with addr"
, "specified"
]

coalesceTokensPerAddr =
let toTxOut (addr, assets) =
Expand Down
3 changes: 3 additions & 0 deletions lib/wallet/api/http/Cardano/Wallet/Api/Types.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3128,6 +3128,9 @@ data ApiMintBurnDataFromInput (n :: NetworkDiscriminant) = ApiMintBurnDataFromIn
{ referenceInput
:: !ReferenceInput
-- ^ A reference input that contains script regulating minting/burning policy.
, policyId
:: !(ApiT W.TokenPolicyId)
-- ^ A policy id of the script regulating minting/burning policy.
, assetName
:: !(Maybe (ApiT W.TokenName))
-- ^ The name of the asset to mint/burn.
Expand Down
Loading
Loading