Skip to content

Commit

Permalink
Support Byron wallets from balanceTx
Browse files Browse the repository at this point in the history
  • Loading branch information
@Anviking
Anviking committed Mar 22, 2023
1 parent e2d6f83 commit 889c285
Show file tree
Hide file tree
Showing 11 changed files with 629 additions and 189 deletions.
2 changes: 2 additions & 0 deletions lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Error.hs
View file
Expand Up @@ -109,6 +109,8 @@ import Cardano.Wallet.Primitive.Types.Tx.SealedTx
( serialisedTx )
import Cardano.Wallet.Shelley.Transaction
( KeyWitnessCount (..) )
import Cardano.Wallet.Shelley.Transaction
( KeyWitnessCount (..) )
import Cardano.Wallet.Transaction
( ErrAssignRedeemers (..), ErrSignTx (..) )
import Cardano.Wallet.Write.Tx.Balance
Expand Down
51 changes: 28 additions & 23 deletions lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs
View file
Expand Up @@ -682,7 +682,7 @@ import qualified Cardano.Wallet.Primitive.Types.UTxOSelection as UTxOSelection
import qualified Cardano.Wallet.Read as Read
import qualified Cardano.Wallet.Registry as Registry
import qualified Cardano.Wallet.Write.Tx as WriteTx
import qualified Cardano.Wallet.Write.Tx.Balance as W
import qualified Cardano.Wallet.Write.Tx.Balance as WriteTx
import qualified Control.Concurrent.Concierge as Concierge
import qualified Data.ByteString as BS
import qualified Data.Foldable as F
Expand Down Expand Up @@ -1760,7 +1760,7 @@ selectCoins ctx@ApiLayer {..} argGenChange (ApiT walletId) body = do
& maybe (pure NoWithdrawal)
(shelleyOnlyMkWithdrawal @s @k @n
netLayer txLayer db walletId era)
let genChange = W.defaultChangeAddressGen argGenChange
let genChange = W.defaultChangeAddressGen argGenChange (Proxy @k)
let paymentOuts = NE.toList $ addressAmountToTxOut <$> body ^. #payments
let txCtx = defaultTransactionCtx
{ txWithdrawal = withdrawal
Expand Down Expand Up @@ -1829,7 +1829,9 @@ selectCoinsForJoin ctx@ApiLayer{..}
poolId
poolStatus
walletId
let changeAddrGen = W.defaultChangeAddressGen (delegationAddress @n)
let changeAddrGen = W.defaultChangeAddressGen
(delegationAddress @n)
(Proxy @k)

let txCtx = defaultTransactionCtx { txDelegationAction = Just action }

Expand Down Expand Up @@ -1882,7 +1884,9 @@ selectCoinsForQuit ctx@ApiLayer{..} (ApiT walletId) = do
withdrawal <- W.shelleyOnlyMkSelfWithdrawal @_ @_ @_ @_ @n
netLayer txLayer era db walletId
action <- WD.quitStakePoolDelegationAction db walletId withdrawal
let changeAddrGen = W.defaultChangeAddressGen (delegationAddress @n)
let changeAddrGen = W.defaultChangeAddressGen
(delegationAddress @n)
(Proxy @k)
let txCtx = defaultTransactionCtx
{ txDelegationAction = Just action
, txWithdrawal = withdrawal
Expand Down Expand Up @@ -2823,7 +2827,7 @@ constructSharedTransaction
-> ApiConstructTransactionData n
-> Handler (ApiConstructTransaction n)
constructSharedTransaction
ctx genChange _knownPools _getPoolStatus (ApiT wid) body = do
ctx argGenChange _knownPools _getPoolStatus (ApiT wid) body = do
let isNoPayload =
isNothing (body ^. #payments) &&
isNothing (body ^. #withdrawal) &&
Expand Down Expand Up @@ -2870,7 +2874,7 @@ constructSharedTransaction
txLayer netLayer db wid txCtx PreSelection {outputs = outs}

balancedTx <-
balanceTransaction ctx genChange scriptLookup
balanceTransaction ctx argGenChange scriptLookup
(Just (Shared.paymentTemplate $ getState cp)) (ApiT wid)
ApiBalanceTransactionPostData
{ transaction =
Expand Down Expand Up @@ -3005,10 +3009,10 @@ balanceTransaction

let mkPartialTx
:: forall era. WriteTx.IsRecentEra era => Cardano.Tx era
-> Handler (W.PartialTx era)
-> Handler (WriteTx.PartialTx era)
mkPartialTx tx = do
utxo <- fmap WriteTx.toCardanoUTxO $ mkLedgerUTxO $ body ^. #inputs
pure $ W.PartialTx
pure $ WriteTx.PartialTx
tx
utxo
(fromApiRedeemer <$> body ^. #redeemers)
Expand All @@ -3035,7 +3039,7 @@ balanceTransaction
mkRecentEra = case Cardano.cardanoEra @era of
Cardano.BabbageEra -> pure WriteTx.RecentEraBabbage
Cardano.AlonzoEra -> pure WriteTx.RecentEraAlonzo
_ -> liftHandler $ throwE $ W.ErrOldEraNotSupported era
_ -> liftHandler $ throwE $ WriteTx.ErrOldEraNotSupported era

mkLedgerUTxO
:: [ApiExternalInput n]
Expand All @@ -3051,18 +3055,20 @@ balanceTransaction

let balanceTx
:: forall era. WriteTx.IsRecentEra era
=> W.PartialTx era
=> WriteTx.PartialTx era
-> Handler (Cardano.Tx era)
balanceTx partialTx =
liftHandler $ fst <$> W.balanceTransaction @_ @IO @s @k @ktype
liftHandler $ fst <$> WriteTx.balanceTransaction @_ @IO @s
(MsgWallet . W.MsgBalanceTx >$< wrk ^. W.logger)
(ctx ^. typed)
genInpScripts
mScriptTemplate
(WriteTx.CoinSelection
txLayer
genInpScripts
mScriptTemplate
(const True) "") -- FIXME
(pp, nodePParams)
ti
utxoIndex
(W.defaultChangeAddressGen argGenChange)
(W.defaultChangeAddressGen argGenChange (Proxy @k))
(getState wallet)
partialTx
where
Expand All @@ -3074,7 +3080,7 @@ balanceTransaction
])
$ W.currentNodeProtocolParameters pp

anyRecentTx <- maybeToHandler (W.ErrOldEraNotSupported era)
anyRecentTx <- maybeToHandler (WriteTx.ErrOldEraNotSupported era)
. WriteTx.asAnyRecentEra
. cardanoTxIdeallyNoLaterThan era
. getApiT $ body ^. #transaction
Expand Down Expand Up @@ -3444,17 +3450,16 @@ joinStakePool
let tr = wrk ^. logger
db = wrk ^. typed @(DBLayer IO s k)
ti = timeInterpreter netLayer
genChange = W.defaultChangeAddressGen argGenChange

(BuiltTx{..}, txTime) <- liftIO $
W.buildSignSubmitTransaction @k @'CredFromKeyK @s @n
W.buildSignSubmitTransaction @k @s @n
ti
db
netLayer
txLayer
(coerce $ getApiT $ body ^. #passphrase)
walletId
genChange
(W.defaultChangeAddressGen argGenChange (Proxy @k))
(AnyRecentEra recentEra)
(PreSelection [])
=<< WD.joinStakePool
Expand Down Expand Up @@ -3511,7 +3516,7 @@ delegationFee ctx@ApiLayer{..} (ApiT walletId) = do
txLayer
(timeInterpreter netLayer)
(AnyRecentEra recentEra)
(W.defaultChangeAddressGen (delegationAddress @n))
(W.defaultChangeAddressGen (delegationAddress @n) (Proxy @k))
walletId
pure $ mkApiFee (Just deposit) [] feePercentiles

Expand Down Expand Up @@ -3545,14 +3550,14 @@ quitStakePool ctx@ApiLayer{..} argGenChange (ApiT walletId) body = do
Just Refl -> liftIO $ WD.quitStakePool netLayer db ti walletId
_ -> liftHandler $ throwE ErrReadRewardAccountNotAShelleyWallet
(BuiltTx{..}, txTime) <- liftIO $ do
W.buildSignSubmitTransaction @k @'CredFromKeyK @s @n
W.buildSignSubmitTransaction @k @s @n
ti
db
netLayer
txLayer
(coerce $ getApiT $ body ^. #passphrase)
walletId
(W.defaultChangeAddressGen argGenChange)
(W.defaultChangeAddressGen argGenChange (Proxy @k))
(AnyRecentEra recentEra)
(PreSelection [])
txCtx
Expand Down Expand Up @@ -4147,7 +4152,7 @@ guardIsRecentEra (Cardano.AnyCardanoEra era) = case era of
Cardano.ShelleyEra -> liftE invalidEra
Cardano.ByronEra -> liftE invalidEra
where
invalidEra = W.ErrOldEraNotSupported $ Cardano.AnyCardanoEra era
invalidEra = WriteTx.ErrOldEraNotSupported $ Cardano.AnyCardanoEra era

mkWithdrawal
:: forall (n :: NetworkDiscriminant) ktype tx block
Expand Down
24 changes: 13 additions & 11 deletions lib/wallet/src/Cardano/Api/Gen.hs
View file
Expand Up @@ -301,10 +301,9 @@ genSlotNo32 = do

genLovelace :: Gen Lovelace
genLovelace = frequency
[ (10, Lovelace . intCast . getNonNegative @Int <$> arbitrary)
, (50, choose (1_000_000, 1_000_000_000))
, (10, choose (txOutMinLovelace, txOutMaxLovelace))
, (30, genEncodingBoundaryLovelace)
[ (3, Lovelace . intCast . getNonNegative @Int <$> arbitrary)
, (95, choose (1_000_000, 10_000_000_000))
, (2, genEncodingBoundaryLovelace)
]

genEncodingBoundaryLovelace :: Gen Lovelace
Expand Down Expand Up @@ -517,7 +516,9 @@ genAssetName :: Gen AssetName
genAssetName =
frequency
-- mostly from a small number of choices, so we get plenty of repetition
[ (9, elements ["", "a", "b", "c"])
[ (7, pure "")
, (5, pure "a")
, (3, elements ["b", "c"])
, (1, AssetName . fromString <$> (scale (min 32) (listOf genAlphaNum)))
, (1, AssetName . fromString <$> (vectorOf 1 genAlphaNum))
, (1, AssetName . fromString <$> (vectorOf 32 genAlphaNum))
Expand All @@ -533,8 +534,9 @@ genPolicyId = frequency
--
-- And because of the additional choice of asset name we repeat ourselves
-- even more here.
[ (80, pure $ fromString ('a' : replicate 55 '0'))
, (18, elements [ fromString (x : replicate 55 '0') | x <- ['a'..'c'] ])
[ (70, pure $ fromString ('a' : replicate 55 '0'))
, (20, pure $ fromString ('b' : replicate 55 '0'))
, (8, pure $ fromString ('c' : replicate 55 '0'))
-- and some from the full range of the type
, (2, PolicyId <$> genScriptHash)
]
Expand Down Expand Up @@ -583,7 +585,7 @@ genSignedValue = do
-- | Generate a 'Value' suitable for minting, i.e. non-ADA asset ID and a
-- positive or negative quantity.
genValueForMinting :: Gen Value
genValueForMinting =
genValueForMinting = scale (`div` 2) $
valueFromList <$> listOf ((,) <$> genAssetIdNoAda <*> genSignedQuantity)

genTxMintValue :: forall era. CardanoEra era -> Gen (TxMintValue BuildTx era)
Expand Down Expand Up @@ -892,7 +894,7 @@ genPaymentCredential :: Gen PaymentCredential
genPaymentCredential =
oneof
[ byKey
, byScript
-- , byScript -- FIXME
]
where
byKey :: Gen PaymentCredential
Expand Down Expand Up @@ -928,7 +930,7 @@ genAddressInEra era =

ShelleyBasedEra _ ->
oneof
[ byronAddressInEra <$> genAddressByron
[ byronAddressInEra <$> genAddressByron
, shelleyAddressInEra <$> genAddressShelley
]

Expand Down Expand Up @@ -1402,7 +1404,7 @@ genTxBodyContent era = do
txIns <- listOf1 genTxIn
ctxs <- vectorOf (length txIns) (genWitnessSpend era)
pure $ zip txIns (BuildTxWith <$> ctxs)
txOuts <- scale (`div` 3) $ listOf1 $ genTxOut era
txOuts <- listOf1 $ scale (`div` 4) $ genTxOut era
txFee <- genTxFee era
txValidityRange <- genTxValidityRange era
txMetadata <- genTxMetadataInEra era
Expand Down

0 comments on commit 889c285

Please sign in to comment.