Skip to content

Commit

Permalink
Merge #2167
Browse files Browse the repository at this point in the history
2167: Add transaction TTL to payments API r=rvl a=rvl

### Issue Number

ADP-93 / #1840

### Overview

- [x] Add transaction TTL to swagger spec. User provides the value in seconds.
- [x] Add transaction TTL to API types
- [x] Add TTL slot calculation to API handler function
- [x] Adjust mkStdTx to make ttl easier - it now takes the expiry slot directly.
- [x] Integration tests

### Comments

Next PRs
- [x] Allow deleting expired transactions ⇒ #2262
- [x] Add CLI option `cardano-wallet transaction create [--ttl=SECONDS]` ⇒ #2267
- [ ] Perhaps clean up the large number of function arguments and return values in transaction layer functions.


Co-authored-by: Rodney Lorrimar <rodney.lorrimar@iohk.io>
  • Loading branch information
iohk-bors[bot] and rvl authored Oct 27, 2020
2 parents 368b9fc + 3a1bd17 commit 5f87791
Show file tree
Hide file tree
Showing 25 changed files with 1,063 additions and 581 deletions.
23 changes: 18 additions & 5 deletions lib/core-integration/src/Test/Integration/Framework/DSL.hs
Original file line number Diff line number Diff line change
Expand Up @@ -118,6 +118,7 @@ module Test.Integration.Framework.DSL
, unsafeGetTransactionTime
, getTxId
, oneSecond
, getTTLSlots

-- * Delegation helpers
, mkEpochInfo
Expand Down Expand Up @@ -284,7 +285,7 @@ import Data.Quantity
import Data.Text
( Text )
import Data.Time
( UTCTime )
( NominalDiffTime, UTCTime )
import Data.Time.Text
( iso8601ExtendedUtc, utcTimeToText )
import Data.Word
Expand Down Expand Up @@ -542,8 +543,9 @@ walletId =
minUTxOValue :: Natural
minUTxOValue = 1_000_000

-- | Wallet server's chosen transaction TTL value (in slots) when none is given.
defaultTxTTL :: SlotNo
-- | Wallet server's chosen transaction TTL value (in seconds) when none is
-- given.
defaultTxTTL :: NominalDiffTime
defaultTxTTL = 7200

--
Expand Down Expand Up @@ -1882,7 +1884,7 @@ pubKeyFromMnemonics mnemonics =
-- Helper for delegation statuses
--
getSlotParams
:: (Context t)
:: Context t
-> IO (EpochNo, SlotParameters)
getSlotParams ctx = do
r1 <- request @ApiNetworkInformation ctx
Expand All @@ -1901,11 +1903,22 @@ getSlotParams ctx = do
let sp = SlotParameters
(EpochLength epochL)
(SlotLength slotL)
(genesisBlockDate)
genesisBlockDate
(ActiveSlotCoefficient coeff)

return (currentEpoch, sp)

-- | Converts a transaction TTL in seconds into a number of slots, using the
-- slot length.
getTTLSlots
:: Context t
-> NominalDiffTime
-> IO SlotNo
getTTLSlots ctx dt = do
(_, SlotParameters _ (SlotLength _slotLenWrong) _ _) <- getSlotParams ctx
let slotLen = 0.2 -- fixme: this is the value from byron genesis
pure $ SlotNo $ ceiling $ dt / slotLen

-- | Handy constructor for ApiEpochInfo
mkEpochInfo
:: EpochNo
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -75,6 +75,7 @@ module Test.Integration.Framework.TestData
, errMsg404MinUTxOValue
, errMsg400TxTooLarge
, errMsg403CouldntIdentifyAddrAsMine
, errMsg503PastHorizon
) where

import Prelude
Expand Down Expand Up @@ -442,3 +443,6 @@ errMsg403CouldntIdentifyAddrAsMine :: String
errMsg403CouldntIdentifyAddrAsMine = "I \
\couldn't identify this address as one of mine. It likely belongs to another wallet and I \
\will therefore not import it."

errMsg503PastHorizon :: String
errMsg503PastHorizon = "Tried to convert something that is past the horizon"
Original file line number Diff line number Diff line change
Expand Up @@ -75,7 +75,7 @@ import Data.Text
import Data.Text.Class
( FromText (..), ToText (..) )
import Data.Time.Clock
( UTCTime, addUTCTime )
( NominalDiffTime, UTCTime, addUTCTime )
import Data.Time.Utils
( utcTimePred, utcTimeSucc )
import Data.Word
Expand All @@ -87,7 +87,7 @@ import Numeric.Natural
import Test.Hspec
( SpecWith, describe )
import Test.Hspec.Expectations.Lifted
( shouldBe, shouldSatisfy )
( shouldBe, shouldNotBe, shouldSatisfy )
import Test.Hspec.Extra
( it )
import Test.Integration.Framework.DSL
Expand Down Expand Up @@ -115,6 +115,7 @@ import Test.Integration.Framework.DSL
, fixtureWallet
, fixtureWalletWith
, getFromResponse
, getTTLSlots
, json
, listAddresses
, listAllTransactions
Expand Down Expand Up @@ -596,7 +597,11 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do
(#balance . #available)
(`shouldBe` Quantity (faucetAmt - feeEstMax - amt)) ra2

it "TRANS_CREATE_10 - Pending transaction expiry" $ \ctx -> do
let absSlotB = view (#absoluteSlotNumber . #getApiT)
let absSlotS = view (#absoluteSlotNumber . #getApiT)
let slotDiff a b = if a > b then a - b else b - a

it "TRANS_TTL_01 - Pending transaction expiry" $ \ctx -> do
(wa, wb) <- (,) <$> fixtureWallet ctx <*> fixtureWallet ctx
let amt = minUTxOValue :: Natural

Expand All @@ -607,8 +612,6 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do

verify r
[ expectSuccess
, expectResponseCode HTTP.status202
, expectField (#direction . #getApiT) (`shouldBe` Outgoing)
, expectField (#status . #getApiT) (`shouldBe` Pending)
, expectField #expiresAt (`shouldSatisfy` isJust)
]
Expand All @@ -617,13 +620,101 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do

-- Get insertion slot and out of response.
let (_, Right apiTx) = r
let Just sl = view (#absoluteSlotNumber . #getApiT) <$> apiTx ^. #pendingSince
let Just sl = absSlotB <$> apiTx ^. #pendingSince

-- The expected expiry slot (adds the hardcoded default ttl)
ttl <- getTTLSlots ctx defaultTxTTL
let txExpectedExp = sl + ttl

-- The actual expiry slot
let Just txActualExp = absSlotS <$> apiTx ^. #expiresAt

-- Expected and actual are fairly close
slotDiff txExpectedExp txActualExp `shouldSatisfy` (< 50)

it "TRANS_TTL_02 - Custom transaction expiry" $ \ctx -> do
(wa, wb) <- (,) <$> fixtureWallet ctx <*> fixtureWallet ctx
let amt = minUTxOValue :: Natural
let testTTL = 42 :: NominalDiffTime

basePayload <- mkTxPayload ctx wb amt fixturePassphrase
let payload = addTxTTL (realToFrac testTTL) basePayload

r <- request @(ApiTransaction n) ctx
(Link.createTransaction @'Shelley wa) Default payload

verify r
[ expectSuccess
, expectField (#status . #getApiT) (`shouldBe` Pending)
, expectField #expiresAt (`shouldSatisfy` isJust)
]

-- Get insertion slot and out of response.
let (_, Right apiTx) = r
let Just sl = absSlotB <$> apiTx ^. #pendingSince

-- The expected expiry slot (adds the hardcoded default ttl)
let ttl = sl + defaultTxTTL
ttl <- getTTLSlots ctx testTTL
let txExpectedExp = sl + ttl

(view #absoluteSlotNumber <$> (apiTx ^. #expiresAt))
`shouldBe` Just (ApiT ttl)
-- The actual expiry slot
let Just txActualExp = absSlotS <$> apiTx ^. #expiresAt

-- Expected and actual are fairly close. Any difference should only be
-- due to slot rounding.
slotDiff txExpectedExp txActualExp `shouldSatisfy` (< 50)

it "TRANS_TTL_03 - Expired transactions" $ \ctx -> do
(wa, wb) <- (,) <$> fixtureWallet ctx <*> fixtureWallet ctx
let amt = minUTxOValue :: Natural

-- this transaction is going to expire really soon.
basePayload <- mkTxPayload ctx wb amt fixturePassphrase
let payload = addTxTTL 0.1 basePayload

ra <- request @(ApiTransaction n) ctx
(Link.createTransaction @'Shelley wa) Default payload

verify ra
[ expectSuccess
, expectField (#status . #getApiT) (`shouldBe` Pending)
, expectField #expiresAt (`shouldSatisfy` isJust)
]

let txid = getFromResponse #id ra
let linkSrc = Link.getTransaction @'Shelley wa (ApiTxId txid)

rb <- eventually "transaction is no longer pending" $ do
rr <- request @(ApiTransaction n) ctx linkSrc Default Empty
verify rr
[ expectSuccess
, expectField (#status . #getApiT) (`shouldNotBe` Pending)
]
pure rr

verify rb
[ expectField (#status . #getApiT) (`shouldBe` Expired)
, expectField #expiresAt (`shouldSatisfy` isJust)
]

it "TRANS_TTL_04 - Large TTL" $ \ctx -> do
(wa, wb) <- (,) <$> fixtureWallet ctx <*> fixtureWallet ctx
let amt = minUTxOValue :: Natural
let hugeTTL = 1e9 :: NominalDiffTime

basePayload <- mkTxPayload ctx wb amt fixturePassphrase
let payload = addTxTTL (realToFrac hugeTTL) basePayload

r <- request @(ApiTransaction n) ctx
(Link.createTransaction @'Shelley wa) Default payload

-- If another HFC Era is added, then this payment request will fail
-- because the expiry would be past the slotting horizon.
verify r
[ expectSuccess
, expectField (#status . #getApiT) (`shouldBe` Pending)
, expectField #expiresAt (`shouldSatisfy` isJust)
]

it "TRANSMETA_CREATE_01 - Transaction with metadata" $ \ctx -> do
(wa, wb) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx
Expand Down Expand Up @@ -2544,6 +2635,12 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do
"passphrase": #{passphrase}
}|]

addTxTTL :: Double -> Payload -> Payload
addTxTTL t (Json (Aeson.Object o)) = Json (Aeson.Object (o <> ttl))
where
ttl = "time_to_live" .= [json|{ "quantity": #{t}, "unit": "second"}|]
addTxTTL _ _ = error "can't do that"

addTxMetadata :: Aeson.Value -> Payload -> Payload
addTxMetadata md (Json (Aeson.Object o)) =
Json (Aeson.Object (o <> ("metadata" .= md)))
Expand Down
Loading

0 comments on commit 5f87791

Please sign in to comment.