Skip to content

Commit

Permalink
Try #2462:
Browse files Browse the repository at this point in the history
  • Loading branch information
@iohk-bors
iohk-bors[bot] authored Jan 27, 2021
2 parents 736ad57 + 619bb67 commit 31477ef
Show file tree
Hide file tree
Showing 28 changed files with 1,286 additions and 5,129 deletions.
1 change: 0 additions & 1 deletion lib/core-integration/cardano-wallet-core-integration.cabal
View file
Original file line number Diff line number Diff line change
Expand Up @@ -109,6 +109,5 @@ library
Test.Integration.Scenario.CLI.Miscellaneous
Test.Integration.Scenario.CLI.Network
Test.Integration.Scenario.CLI.Port
Cardano.Wallet.TransactionSpecShared
Cardano.Wallet.LatencyBenchShared
Cardano.Wallet.BenchShared
65 changes: 0 additions & 65 deletions lib/core-integration/src/Cardano/Wallet/TransactionSpecShared.hs
View file

This file was deleted.

49 changes: 14 additions & 35 deletions lib/core-integration/src/Test/Integration/Framework/TestData.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -38,11 +38,9 @@ module Test.Integration.Framework.TestData
, errMsg400WalletIdEncoding
, errMsg400StartTimeLaterThanEndTime
, errMsg403Fee
, errMsg403DelegationFee
, errMsg403NotAByronWallet
, errMsg403NotAnIcarusWallet
, errMsg403NotEnoughMoney
, errMsg403NotEnoughMoney_
, errMsg403WrongPass
, errMsg403AlreadyInLedger
, errMsg404NoSuchPool
Expand Down Expand Up @@ -72,7 +70,7 @@ module Test.Integration.Framework.TestData
, errMsg403WithdrawalNotWorth
, errMsg403NotAShelleyWallet
, errMsg403InputsDepleted
, errMsg404MinUTxOValue
, errMsg403MinUTxOValue
, errMsg403TxTooLarge
, errMsg403CouldntIdentifyAddrAsMine
, errMsg503PastHorizon
Expand All @@ -86,8 +84,6 @@ import Data.Text
( Text, pack, unpack )
import Data.Word
( Word32 )
import Numeric.Natural
( Natural )
import Test.Integration.Framework.DSL
( Payload (..), fixturePassphrase, json )

Expand Down Expand Up @@ -230,14 +226,13 @@ errMsg403InputsDepleted = "I cannot select enough UTxO from your wallet to const
\ an adequate transaction. Try sending a smaller amount or increasing the number\
\ of available UTxO."

errMsg404MinUTxOValue :: Natural -> String
errMsg404MinUTxOValue minUTxOValue = mconcat
[ "I'm unable to construct the given transaction as some outputs or changes"
, " are too small! Each output and change is expected to be >= "
, (show minUTxOValue)
, " Lovelace. In the current transaction the following pieces are not"
, " satisfying this condition"
]
errMsg403MinUTxOValue :: String
errMsg403MinUTxOValue =
"Some outputs specifies an Ada value that is too small. Indeed, there's a \
\minimum Ada value specified by the protocol that each output must satisfy. \
\I'll handle that minimum value myself when you do not explicitly specify \
\an Ada value for outputs. Otherwise, you must specify enough Ada."

errMsg409WalletExists :: String -> String
errMsg409WalletExists walId = "This operation would yield a wallet with the following\
\ id: " ++ walId ++ " However, I already know of a wallet with this id."
Expand All @@ -256,15 +251,9 @@ errMsg400StartTimeLaterThanEndTime startTime endTime = mconcat
]

errMsg403Fee :: String
errMsg403Fee = "I'm unable to adjust the given transaction to cover the\
\ associated fee! In order to do so, I'd have to select one or\
\ more additional inputs, but I can't do that without increasing\
\ the size of the transaction beyond the acceptable limit."

errMsg403DelegationFee :: Natural -> String
errMsg403DelegationFee n =
"I'm unable to select enough coins to pay for a delegation certificate. \
\I need: " ++ show n ++ " Lovelace."
errMsg403Fee =
"I am unable to finalize the transaction as there are not enough Ada I can \
\use to pay for either fees, or minimum Ada value in change outputs."

errMsg403NotAByronWallet :: String
errMsg403NotAByronWallet =
Expand All @@ -276,21 +265,11 @@ errMsg403NotAnIcarusWallet =
"I cannot derive new address for this wallet type.\
\ Make sure to use a sequential wallet style, like Icarus."

errMsg403NotEnoughMoney_ :: String
errMsg403NotEnoughMoney_ =
"I can't process this payment because there's not enough UTxO available in \
errMsg403NotEnoughMoney :: String
errMsg403NotEnoughMoney =
"I can't process this payment because there's not enough funds available in \
\the wallet."

errMsg403NotEnoughMoney :: Integral i => i -> i -> String
errMsg403NotEnoughMoney has needs = "I can't process this payment because there's\
\ not enough UTxO available in the wallet. The total UTxO sums up to\
\ " ++ has' ++ " Lovelace, but I need " ++ needs' ++ " Lovelace\
\ (excluding fee amount) in order to proceed with the payment."

where
needs' = show (toInteger needs)
has' = show (toInteger has)

errMsg403TxTooBig :: Int -> String
errMsg403TxTooBig n = "I had to select " ++ show n ++ " inputs to construct the\
\ requested transaction. Unfortunately, this would create a transaction\
Expand Down
55 changes: 23 additions & 32 deletions lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -36,10 +36,9 @@ import Cardano.Wallet.Primitive.AddressDerivation
( PaymentAddress )
import Cardano.Wallet.Primitive.AddressDerivation.Shelley
( ShelleyKey )
import Cardano.Wallet.Primitive.Fee
( FeePolicy (..) )
import Cardano.Wallet.Primitive.Types
( PoolId (..)
( FeePolicy (..)
, PoolId (..)
, PoolMetadataGCStatus (..)
, PoolMetadataSource (..)
, StakePoolMetadata (..)
Expand Down Expand Up @@ -130,11 +129,13 @@ import Test.Integration.Framework.DSL
, waitForNextEpoch
, walletId
, (.>)
, (.>=)
)
import Test.Integration.Framework.TestData
( errMsg403DelegationFee
( errMsg403Fee
, errMsg403NonNullReward
, errMsg403NotDelegating
, errMsg403NotEnoughMoney
, errMsg403PoolAlreadyJoined
, errMsg403WrongPass
, errMsg404NoSuchPool
Expand Down Expand Up @@ -376,23 +377,19 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
-- because there is a fee for this tx
[ expectResponseCode HTTP.status202
, expectField (#status . #getApiT) (`shouldBe` Pending)
, expectField (#direction . #getApiT) (`shouldBe` Outgoing)
, expectField (#direction . #getApiT) (`shouldBe` Incoming)
]
let txid = getFromResponse Prelude.id rq
let (Quantity quitFeeAmt) = getFromResponse #amount rq
let finalQuitAmt = Quantity (depositAmt ctx - quitFeeAmt)
let quitFeeAmt = getFromResponse #amount rq

eventually "Certificates are inserted after quiting a pool" $ do
-- last made transaction `txid` is for quitting pool and,
-- in fact, it becomes incoming because there is
-- keyDeposit being returned
let epg = Link.getTransaction @'Shelley src txid
rlg <- request @(ApiTransaction n) ctx epg Default Empty
verify rlg
[ expectField
(#direction . #getApiT) (`shouldBe` Incoming)
, expectField
#amount (`shouldBe` finalQuitAmt)
#amount (`shouldBe` quitFeeAmt)
, expectField
(#status . #getApiT) (`shouldBe` InLedger)
]
Expand All @@ -403,7 +400,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
[ expectListField 0
(#direction . #getApiT) (`shouldBe` Incoming)
, expectListField 0
#amount (`shouldBe` finalQuitAmt)
#amount (`shouldBe` quitFeeAmt)
, expectListField 0
(#status . #getApiT) (`shouldBe` InLedger)
, expectListField 1
Expand Down Expand Up @@ -823,7 +820,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
describe "STAKE_POOLS_JOIN_01x - Fee boundary values" $ do
it "STAKE_POOLS_JOIN_01x - \
\I can join if I have just the right amount" $ \ctx -> runResourceT $ do
w <- fixtureWalletWith @n ctx [costOfJoining ctx + depositAmt ctx]
w <- fixtureWalletWith @n ctx [costOfJoining ctx + depositAmt ctx + minUTxOValue]
pool:_ <- map (view #id) . snd <$>
unsafeRequest @[ApiStakePool]
ctx (Link.listStakePools arbitraryStake) Empty
Expand All @@ -835,27 +832,26 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do

it "STAKE_POOLS_JOIN_01x - \
\I cannot join if I have not enough fee to cover" $ \ctx -> runResourceT $ do
w <- fixtureWalletWith @n ctx [costOfJoining ctx + depositAmt ctx - 1]
w <- fixtureWalletWith @n ctx [costOfJoining ctx + depositAmt ctx + minUTxOValue - 1]
pool:_ <- map (view #id) . snd <$>
unsafeRequest @[ApiStakePool]
ctx (Link.listStakePools arbitraryStake) Empty
joinStakePool @n ctx pool (w, fixturePassphrase) >>= flip verify
[ expectResponseCode HTTP.status403
, expectErrorMessage (errMsg403DelegationFee 1)
, expectErrorMessage errMsg403Fee
]

describe "STAKE_POOLS_QUIT_01x - Fee boundary values" $ do

it "STAKE_POOLS_QUIT_01xx - \
\I can quit if I have enough to cover fee" $ \ctx -> runResourceT $ do
-- change needed to satisfy minUTxOValue
let change = minUTxOValue - costOfQuitting ctx
let initBalance =
[ costOfJoining ctx
+ depositAmt ctx
+ minUTxOValue
+ costOfQuitting ctx
+ change
+ costOfChange ctx
+ minUTxOValue
]
w <- fixtureWalletWith @n ctx initBalance

Expand All @@ -879,7 +875,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
verify rQuit
[ expectResponseCode HTTP.status202
, expectField (#status . #getApiT) (`shouldBe` Pending)
, expectField (#direction . #getApiT) (`shouldBe` Outgoing)
, expectField (#direction . #getApiT) (`shouldBe` Incoming)
, expectField #inputs $ \inputs' -> do
inputs' `shouldSatisfy` all (isJust . source)
]
Expand All @@ -901,17 +897,15 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
request @ApiWallet ctx (Link.getWallet @'Shelley w)
Default Empty >>= flip verify
[ expectField #delegation (`shouldBe` notDelegating [])
, expectField
(#balance . #total)
(`shouldSatisfy` (== (Quantity (depositAmt ctx + change))))
, expectField
(#balance . #available)
(`shouldSatisfy` (== (Quantity (depositAmt ctx + change))))
, expectField (#balance . #total)
(.>= Quantity (depositAmt ctx))
, expectField (#balance . #available)
(.>= Quantity (depositAmt ctx))
]

it "STAKE_POOLS_QUIT_01x - \
\I cannot quit if I have not enough to cover fees" $ \ctx -> runResourceT $ do
let initBalance = [ costOfJoining ctx + depositAmt ctx ]
let initBalance = [ costOfJoining ctx + depositAmt ctx + minUTxOValue ]
w <- fixtureWalletWith @n ctx initBalance

pool:_ <- map (view #id) . snd
Expand All @@ -932,15 +926,15 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do

quitStakePool @n ctx (w, fixturePassphrase) >>= flip verify
[ expectResponseCode HTTP.status403
, expectErrorMessage $ errMsg403DelegationFee 116500
, expectErrorMessage errMsg403Fee
]

it "STAKE_POOLS_ESTIMATE_FEE_02 - \
\empty wallet cannot estimate fee" $ \ctx -> runResourceT $ do
w <- emptyWallet ctx
delegationFee ctx w >>= flip verify
[ expectResponseCode HTTP.status403
, expectErrorMessage $ errMsg403DelegationFee 122900
, expectErrorMessage errMsg403NotEnoughMoney
]

describe "STAKE_POOLS_LIST_01 - List stake pools" $ do
Expand Down Expand Up @@ -1272,14 +1266,11 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
fromIntegral (unCoin c)

costOfJoining :: Context -> Natural
costOfJoining = costOf (\coeff cst -> 370 * coeff + cst)
costOfJoining = costOf (\coeff cst -> 449 * coeff + cst)

costOfQuitting :: Context -> Natural
costOfQuitting = costOf (\coeff cst -> 303 * coeff + cst)

costOfChange :: Context -> Natural
costOfChange = costOf (\coeff _cst -> 133 * coeff)

costOf :: (Natural -> Natural -> Natural) -> Context -> Natural
costOf withCoefficients ctx =
withCoefficients coeff cst
Expand Down
Loading

0 comments on commit 31477ef

Please sign in to comment.