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

Jump to bottom

Fix Change Calculation (#286) #292

Merged
merged 3 commits into from
May 21, 2019
Merged

Fix Change Calculation (#286) #292

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
fa80c12
reproduce bug #286
KtorZ May 21, 2019
37daa16
fix change UTxO calculation
KtorZ May 21, 2019
252cd12
use constants instead of hard-coded numbers in Transactions Scenarios
KtorZ May 21, 2019
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
8 changes: 2 additions & 6 deletions lib/core/src/Cardano/Wallet/Primitive/Model.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -75,8 +75,6 @@ import Control.Monad
( foldM, forM )
import Control.Monad.Trans.State.Strict
( State, evalState, runState, state )
import Data.Foldable
( fold )
import Data.Generics.Internal.VL.Lens
( (^.) )
import Data.Generics.Labels
Expand Down Expand Up @@ -329,10 +327,8 @@ changeUTxO
-> Set Tx
-> s
-> UTxO
changeUTxO proxy pending = evalState $ do
ourUtxo <- mapM (state . utxoOurs proxy) (Set.toList pending)
let ins = txIns pending
return $ fold ourUtxo `restrictedBy` ins
Copy link
Member Author

Choose a reason for hiding this comment

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

Not even sure why this was even there... The spec says:

image

Which is exactly what the first line already does... The two others are non-sense.

changeUTxO proxy pending = evalState $
mconcat <$> mapM (state . utxoOurs proxy) (Set.toList pending)

-- | Construct our _next_ UTxO (possible empty) from a transaction by selecting
-- outputs that are ours. It is important for the transaction outputs to be
Expand Down
20 changes: 14 additions & 6 deletions lib/http-bridge/test/integration/Test/Integration/Framework/DSL.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
Expand Down Expand Up @@ -52,6 +53,7 @@ module Test.Integration.Framework.DSL
, json
, tearDown
, fixtureWallet
, oneMillionAda

-- * CLI
, cardanoWalletCLI
Expand Down Expand Up @@ -382,14 +384,14 @@ walletId =
_set :: HasType (ApiT WalletId) s => (s, Text) -> s
_set (s, v) = set typed (ApiT $ WalletId (unsafeCreateDigest v)) s

amount :: HasType (Quantity "lovelace" Natural) s => Lens' s Int
amount :: HasType (Quantity "lovelace" Natural) s => Lens' s Natural
amount =
lens _get _set
where
_get :: HasType (Quantity "lovelace" Natural) s => s -> Int
_get = fromIntegral . fromQuantity @"lovelace" @Natural . view typed
_set :: HasType (Quantity "lovelace" Natural) s => (s, Int) -> s
_set (s, v) = set typed (Quantity @"lovelace" @Natural $ fromIntegral v) s
_get :: HasType (Quantity "lovelace" Natural) s => s -> Natural
_get = fromQuantity @"lovelace" @Natural . view typed
_set :: HasType (Quantity "lovelace" Natural) s => (s, Natural) -> s
_set (s, v) = set typed (Quantity @"lovelace" @Natural v) s

direction :: HasType (ApiT Direction) s => Lens' s Direction
direction =
Expand Down Expand Up @@ -430,7 +432,7 @@ fixtureWallet ctx@(Context _ _ _ faucet) = do
Left _ -> fail "fixtureWallet: waited too long for initial transaction"
Right a -> return a
where
oneSecond = 1*1000*1000
oneSecond = 1_000_000
Copy link
Contributor

@paweljakubas paweljakubas May 21, 2019 •
edited
Loading

Choose a reason for hiding this comment

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

we do not want Quantity here? maybe it is overstreatch here, but we use second through the code (I believe) and maybe it is not silly idea to introduce time units somewhere. and if so rely on Quantity there

sixtySeconds = 60*oneSecond
checkBalance :: Text -> IO ApiWallet
checkBalance wid = do
Expand All @@ -439,6 +441,12 @@ fixtureWallet ctx@(Context _ _ _ faucet) = do
then return (getFromResponse id r)
else threadDelay oneSecond *> checkBalance wid

-- | One million ADA, in Lovelace, just like this.
oneMillionAda :: Natural
oneMillionAda = ada (1_000_000)
where
ada = (*) (1_000_000)
Copy link
Member

Choose a reason for hiding this comment

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

I wonder if it would be possible to use the type system here, to distinguish amounts (in Ada or Lovelace) from other values that happen to be Natural?

In particular, we're trying to encode something that is a number of Lovelace: the number of lovelace in one Ada.

Copy link
Member Author

Choose a reason for hiding this comment

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

We could use Quantity etc ... But we purposely use raw types in the integration DSL to keep the test scenarios readable and simple to write.

Copy link
Contributor

Choose a reason for hiding this comment

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

that's was my question : why not Quantity here?

Copy link
Member Author

Choose a reason for hiding this comment

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

As just explained, to avoid having to perform to many transformations when writing the integration test scenarios. Scenarios are mostly just about submitting things to the API and asserting results; Manipulating raw types directly there makes it very easy to write these scenarios and piggy-back on the API to do the type-checking etc ...

More importantly, it also allows us to provide invalid and out-of-range values and still submit them to test that API fulfill its role! This is also why we don't use a typed client in the integration tests. We do want to be able to submit invalid values :)

Copy link
Collaborator

Choose a reason for hiding this comment

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

Besides, Quantity might not always help. Consider

pay :: Quantity "lovelace" Natural -> result

-- later

do
pay (Quantity 100)
...

The type is inferred at the call-site and can easily be confused. Would be better to enforce it to be explicit.

Like

do
pay (Lovelace 100)
...

(I'm sure there are fancier ways too)


fromQuantity :: Quantity (u :: Symbol) a -> a
fromQuantity (Quantity a) = a

Expand Down
26 changes: 19 additions & 7 deletions lib/http-bridge/test/integration/Test/Integration/Scenario/Transactions.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -32,6 +32,7 @@ import Test.Integration.Framework.DSL
, expectSuccess
, fixtureWallet
, json
, oneMillionAda
, request
, status
, unsafeRequest
Expand All @@ -55,35 +56,46 @@ spec = do
(wa, wb) <- (,) <$> fixtureWallet ctx <*> fixtureWallet ctx
(_, addrs) <-
unsafeRequest @[ApiAddress] ctx ("GET", getAddresses wb) Empty
let amt = 1
let destination = (addrs !! 1) ^. #id
let payload = Json [json|{
"payments": [{
"address": #{destination},
"amount": {
"quantity": 1,
"quantity": #{amt},
"unit": "lovelace"
}
}],
"passphrase": "cardano-wallet"
}|]
let fee = 168653

r <- request @ApiTransaction ctx ("POST", postTx wa) Default payload
verify r
[ expectSuccess
, expectResponseCode HTTP.status202
, expectFieldEqual amount 168654
, expectFieldEqual amount (fee + amt)
Copy link
Member

Choose a reason for hiding this comment

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

This is much clearer. I like it 👍

, expectFieldEqual direction Outgoing
, expectFieldEqual status Pending
]

r' <- request @ApiWallet ctx ("GET", getWallet wb) Default payload
verify r'
ra <- request @ApiWallet ctx ("GET", getWallet wa) Default payload
verify ra
[ expectSuccess
, expectFieldEqual balanceTotal (oneMillionAda - fee - amt)
Copy link
Member

Choose a reason for hiding this comment

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

👍

, expectFieldEqual balanceAvailable 0
]

rb <- request @ApiWallet ctx ("GET", getWallet wb) Default payload
verify rb
[ expectSuccess
, expectEventually ctx balanceAvailable (oneMillionAda + 1)
, expectEventually ctx balanceAvailable (oneMillionAda + amt)
]

verify ra
[ expectEventually ctx balanceAvailable (oneMillionAda - fee - amt)
Copy link
Member

Choose a reason for hiding this comment

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

Nice :)

]
where
oneMillionAda =
1 * 1000 * 1000 * 1000 * 1000
getAddresses (w :: ApiWallet) =
"v2/wallets/" <> w ^. walletId <> "/addresses"
postTx (w :: ApiWallet) =
Expand Down