Try #3434:

cardano-foundation · Aug 12, 2022 · a408d77 · a408d77
2 parents 9c869db + 3e965ac
commit a408d77
Show file tree

Hide file tree

Showing 8 changed files with 570 additions and 405 deletions.
diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs
@@ -1574,8 +1574,40 @@ balanceTransaction
     => ctx
     -> ArgGenChange s
     -> (W.ProtocolParameters, Cardano.ProtocolParameters)
+    -- ^ 'Cardano.ProtocolParameters' can be retrived via a Local State Query to
+    -- a local node.
+    --
+    -- Providing incorrect values will result in phase 1 script integrity
+    -- hash failures instead of phase 2 failures if script redeemers are
+    -- present in the transaction, ensuring collateral is never forfeited.
+    --
+    -- TODO: Remove 'W.ProtocolParameters' argument.
     -> TimeInterpreter (Either PastHorizonException)
+    -- ^ TODO: Replace with 'Cardano.EraHistory' and 'SystemStart'. The rest of
+    -- the comment will read as if this already had been done:
+    --
+    -- The 'Cardano.EraHistory' and 'SystemStart' is needed to convert
+    -- is needed to convert validity intervals from 'UTCTime' to 'SlotNo' when
+    -- executing Plutus scripts.
+    --
+    -- 'SystemStart' is defined in the genesis file.
+    --
+    -- 'Cardano.EraHistory' can be retrieved via a Local State Query to a local
+    -- node.
+    --
+    -- Both values can be hard-coded for a given network configuration. Just be
+    -- cautious that the 'Cardano.EraHistory' will occasionally change as new
+    -- eras are introduced to Cardano. Incorrect 'Cardano.EraHistory' values
+    -- _may_ result in a loss of collateral.
+    --
+    -- TODO [ADP-1544] or similar ticket: Clarify and/or test whether it's
+    -- actually possible to lose collateral by providing incorrect
+    -- 'Cardano.EraHistory' values.
+    --
+    -- Relevant ledger code: https://github.com/input-output-hk/cardano-ledger/blob/fdec04e8c071060a003263cdcb37e7319fb4dbf3/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxInfo.hs#L428-L440
     -> (UTxOIndex WalletUTxO, Wallet s, Set Tx)
+    -- ^ TODO [ADP-1789] Replace with @Cardano.UTxO@ and something simpler than
+    -- @Wallet s@ for change address generation.
     -> PartialTx era
     -> ExceptT ErrBalanceTx m (Cardano.Tx era)
 balanceTransaction ctx change pp ti wallet ptx = do

diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs
@@ -2787,8 +2787,6 @@ decodeSharedTransaction ctx (ApiT wid) (ApiSerialisedTransaction (ApiT sealed))
         , walletPolicyKeyIndex = Nothing
         }
 
--- TODO: Most of the body of this function should really belong to
--- Cardano.Wallet to keep the Api.Server module free of business logic!
 balanceTransaction
     :: forall ctx s k (n :: NetworkDiscriminant).
         ( ctx ~ ApiLayer s k

diff --git a/lib/core/src/Cardano/Wallet/Primitive/Slotting.hs b/lib/core/src/Cardano/Wallet/Primitive/Slotting.hs
@@ -64,6 +64,9 @@ module Cardano.Wallet.Primitive.Slotting
     , snapshot
     , hoistTimeInterpreter
     , expectAndThrowFailures
+
+     -- * Dummy values for testing
+    , dummyForkInterpreter
     ) where
 
 import Prelude
@@ -100,7 +103,7 @@ import Control.Tracer
 import Data.Coerce
     ( coerce )
 import Data.Functor.Identity
-    ( Identity )
+    ( Identity (runIdentity), runIdentity )
 import Data.Generics.Internal.VL.Lens
     ( (^.) )
 import Data.Kind
@@ -113,14 +116,18 @@ import Data.Text.Class
     ( ToText (..) )
 import Data.Time.Clock
     ( NominalDiffTime, UTCTime, addUTCTime, getCurrentTime )
+import Data.Time.Clock.POSIX
+    ( posixSecondsToUTCTime )
 import Data.Word
     ( Word32, Word64 )
 import Fmt
     ( blockListF', build, fmt, indentF )
 import GHC.Stack
     ( CallStack, HasCallStack, getCallStack, prettySrcLoc )
 import Ouroboros.Consensus.BlockchainTime.WallClock.Types
-    ( RelativeTime (..), SystemStart (SystemStart), addRelTime )
+    ( RelativeTime (..), SystemStart (SystemStart), addRelTime, mkSlotLength )
+import Ouroboros.Consensus.Config
+    ( SecurityParam (..) )
 import Ouroboros.Consensus.HardFork.History.EpochInfo
     ( interpreterToEpochInfo )
 import Ouroboros.Consensus.HardFork.History.Qry
@@ -136,12 +143,15 @@ import Ouroboros.Consensus.HardFork.History.Qry
     )
 import Ouroboros.Consensus.HardFork.History.Summary
     ( neverForksSummary )
+import Ouroboros.Consensus.Util.Counting
+    ( exactlyTwo )
 import UnliftIO.Exception
     ( throwIO )
 
 import qualified Cardano.Slotting.Slot as Cardano
 import qualified Data.Text as T
 import qualified Ouroboros.Consensus.BlockchainTime.WallClock.Types as Cardano
+import qualified Ouroboros.Consensus.HardFork.History.EraParams as HF
 import qualified Ouroboros.Consensus.HardFork.History.Qry as HF
 import qualified Ouroboros.Consensus.HardFork.History.Summary as HF
 
@@ -609,3 +619,32 @@ unsafeExtendSafeZone = f . neverFails r
         , handleResult = h
         }
     r = "unsafeExtendSafeZone should make PastHorizonExceptions impossible."
+
+{-------------------------------------------------------------------------------
+                       For testing
+-------------------------------------------------------------------------------}
+
+-- | A dummy 'TimeInterpreter' for testing. A horizon at @SlotNo 40@ allows
+-- testing 'PastHorizonException's.
+dummyForkInterpreter :: TimeInterpreter (Either PastHorizonException)
+dummyForkInterpreter =
+    let
+        t0 = HF.initBound
+        t1 = HF.Bound
+                (RelativeTime 20)
+                (SlotNo 20)
+                (Cardano.EpochNo 1)
+        t2 = HF.Bound
+                (RelativeTime 40)
+                (SlotNo 40)
+                (Cardano.EpochNo 2)
+
+        era1Params = HF.defaultEraParams (SecurityParam 2) (mkSlotLength 1)
+        summary = HF.summaryWithExactly $ exactlyTwo
+            (HF.EraSummary t0 (HF.EraEnd t1) era1Params)
+            (HF.EraSummary t1 (HF.EraEnd t2) era1Params)
+        in
+            hoistTimeInterpreter (runIdentity . runExceptT) $ mkTimeInterpreter
+                nullTracer
+                (StartTime $ posixSecondsToUTCTime 0)
+                (pure $ HF.mkInterpreter summary)
diff --git a/lib/shelley/test/data/balanceTx/1ada-payment/golden b/lib/shelley/test/data/balanceTx/1ada-payment/golden
@@ -18,64 +18,64 @@
  0.850000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (BalanceInsufficient (BalanceInsufficientError {utxoBalanceAvailable = TokenBundle {coin = Coin 850000, tokens = TokenMap (fromList [])}, utxoBalanceRequired = TokenBundle {coin = Coin 1000000, tokens = TokenMap (fromList [])}}))))
  0.900000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (BalanceInsufficient (BalanceInsufficientError {utxoBalanceAvailable = TokenBundle {coin = Coin 900000, tokens = TokenMap (fromList [])}, utxoBalanceRequired = TokenBundle {coin = Coin 1000000, tokens = TokenMap (fromList [])}}))))
  0.950000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (BalanceInsufficient (BalanceInsufficientError {utxoBalanceAvailable = TokenBundle {coin = Coin 950000, tokens = TokenMap (fromList [])}, utxoBalanceRequired = TokenBundle {coin = Coin 1000000, tokens = TokenMap (fromList [])}}))))
- 1.000000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 168757, shortfall = Coin 168757}))))
- 1.050000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 168757, shortfall = Coin 118757}))))
- 1.100000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 168757, shortfall = Coin 68757}))))
- 1.150000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 168757, shortfall = Coin 18757}))))
- 1.200000,0.200000,0.163741
- 1.250000,0.250000,0.163741
- 1.300000,0.300000,0.163741
- 1.350000,0.350000,0.163741
- 1.400000,0.400000,0.163741
- 1.450000,0.450000,0.163741
- 1.500000,0.500000,0.163741
- 1.550000,0.550000,0.163741
- 1.600000,0.600000,0.163741
- 1.650000,0.650000,0.163741
- 1.700000,0.700000,0.163741
- 1.750000,0.750000,0.163741
- 1.800000,0.800000,0.163741
- 1.850000,0.850000,0.163741
- 1.900000,0.900000,0.163741
- 1.950000,0.950000,0.163741
- 2.000000,1.000000,0.163741
- 2.050000,1.050000,0.163741
- 2.100000,1.100000,0.163741
- 2.150000,1.150000,0.163741
- 2.200000,0.166601,0.166601
- 2.250000,0.166601,0.166601
- 2.300000,0.166601,0.166601
- 2.350000,0.166601,0.166601
- 2.400000,0.166601,0.166601
- 2.450000,0.166601,0.166601
- 2.500000,0.166601,0.166601
- 2.550000,0.166601,0.166601
- 2.600000,0.166601,0.166601
- 2.650000,0.166601,0.166601
- 2.700000,0.166601,0.166601
- 2.750000,0.166601,0.166601
- 2.800000,0.166601,0.166601
- 2.850000,0.166601,0.166601
- 2.900000,0.166601,0.166601
- 2.950000,0.166601,0.166601
- 3.000000,0.166601,0.166601
- 3.050000,0.166601,0.166601
- 3.100000,0.166601,0.166601
- 3.150000,0.166601,0.166601
- 3.200000,0.166601,0.166601
- 3.250000,0.166601,0.166601
- 3.300000,0.166601,0.166601
- 3.350000,0.166601,0.166601
- 3.400000,0.166601,0.166601
- 3.450000,0.166601,0.166601
- 3.500000,0.166601,0.166601
- 3.550000,0.166601,0.166601
- 3.600000,0.166601,0.166601
- 3.650000,0.166601,0.166601
- 3.700000,0.166601,0.166601
- 3.750000,0.166601,0.166601
- 3.800000,0.166601,0.166601
- 3.850000,0.166601,0.166601
- 3.900000,0.166601,0.166601
- 3.950000,0.166601,0.166601
- 4.000000,0.166601,0.166601
+ 1.000000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 168933, shortfall = Coin 168933}))))
+ 1.050000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 168933, shortfall = Coin 118933}))))
+ 1.100000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 168933, shortfall = Coin 68933}))))
+ 1.150000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 168933, shortfall = Coin 18933}))))
+ 1.200000,0.200000,0.163829
+ 1.250000,0.250000,0.163829
+ 1.300000,0.300000,0.163829
+ 1.350000,0.350000,0.163829
+ 1.400000,0.400000,0.163829
+ 1.450000,0.450000,0.163829
+ 1.500000,0.500000,0.163829
+ 1.550000,0.550000,0.163829
+ 1.600000,0.600000,0.163829
+ 1.650000,0.650000,0.163829
+ 1.700000,0.700000,0.163829
+ 1.750000,0.750000,0.163829
+ 1.800000,0.800000,0.163829
+ 1.850000,0.850000,0.163829
+ 1.900000,0.900000,0.163829
+ 1.950000,0.950000,0.163829
+ 2.000000,1.000000,0.163829
+ 2.050000,1.050000,0.163829
+ 2.100000,1.100000,0.163829
+ 2.150000,1.150000,0.163829
+ 2.200000,0.166777,0.166777
+ 2.250000,0.166777,0.166777
+ 2.300000,0.166777,0.166777
+ 2.350000,0.166777,0.166777
+ 2.400000,0.166777,0.166777
+ 2.450000,0.166777,0.166777
+ 2.500000,0.166777,0.166777
+ 2.550000,0.166777,0.166777
+ 2.600000,0.166777,0.166777
+ 2.650000,0.166777,0.166777
+ 2.700000,0.166777,0.166777
+ 2.750000,0.166777,0.166777
+ 2.800000,0.166777,0.166777
+ 2.850000,0.166777,0.166777
+ 2.900000,0.166777,0.166777
+ 2.950000,0.166777,0.166777
+ 3.000000,0.166777,0.166777
+ 3.050000,0.166777,0.166777
+ 3.100000,0.166777,0.166777
+ 3.150000,0.166777,0.166777
+ 3.200000,0.166777,0.166777
+ 3.250000,0.166777,0.166777
+ 3.300000,0.166777,0.166777
+ 3.350000,0.166777,0.166777
+ 3.400000,0.166777,0.166777
+ 3.450000,0.166777,0.166777
+ 3.500000,0.166777,0.166777
+ 3.550000,0.166777,0.166777
+ 3.600000,0.166777,0.166777
+ 3.650000,0.166777,0.166777
+ 3.700000,0.166777,0.166777
+ 3.750000,0.166777,0.166777
+ 3.800000,0.166777,0.166777
+ 3.850000,0.166777,0.166777
+ 3.900000,0.166777,0.166777
+ 3.950000,0.166777,0.166777
+ 4.000000,0.166777,0.166777
diff --git a/lib/shelley/test/data/balanceTx/delegate/golden b/lib/shelley/test/data/balanceTx/delegate/golden
@@ -38,10 +38,10 @@
  1.850000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (BalanceInsufficient (BalanceInsufficientError {utxoBalanceAvailable = TokenBundle {coin = Coin 1850000, tokens = TokenMap (fromList [])}, utxoBalanceRequired = TokenBundle {coin = Coin 2000000, tokens = TokenMap (fromList [])}}))))
  1.900000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (BalanceInsufficient (BalanceInsufficientError {utxoBalanceAvailable = TokenBundle {coin = Coin 1900000, tokens = TokenMap (fromList [])}, utxoBalanceRequired = TokenBundle {coin = Coin 2000000, tokens = TokenMap (fromList [])}}))))
  1.950000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (BalanceInsufficient (BalanceInsufficientError {utxoBalanceAvailable = TokenBundle {coin = Coin 1950000, tokens = TokenMap (fromList [])}, utxoBalanceRequired = TokenBundle {coin = Coin 2000000, tokens = TokenMap (fromList [])}}))))
- 2.000000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 180725, shortfall = Coin 180725}))))
- 2.050000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 180725, shortfall = Coin 130725}))))
- 2.100000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 180725, shortfall = Coin 80725}))))
- 2.150000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 180725, shortfall = Coin 30725}))))
+ 2.000000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 180901, shortfall = Coin 180901}))))
+ 2.050000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 180901, shortfall = Coin 130901}))))
+ 2.100000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 180901, shortfall = Coin 80901}))))
+ 2.150000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 180901, shortfall = Coin 30901}))))
  2.200000,0.200000,0.175401
  2.250000,0.250000,0.175401
  2.300000,0.300000,0.175401
@@ -62,20 +62,20 @@
  3.050000,1.050000,0.175401
  3.100000,1.100000,0.175401
  3.150000,1.150000,0.175401
- 3.200000,0.178261,0.178261
- 3.250000,0.178261,0.178261
- 3.300000,0.178261,0.178261
- 3.350000,0.178261,0.178261
- 3.400000,0.178261,0.178261
- 3.450000,0.178261,0.178261
- 3.500000,0.178261,0.178261
- 3.550000,0.178261,0.178261
- 3.600000,0.178261,0.178261
- 3.650000,0.178261,0.178261
- 3.700000,0.178261,0.178261
- 3.750000,0.178261,0.178261
- 3.800000,0.178261,0.178261
- 3.850000,0.178261,0.178261
- 3.900000,0.178261,0.178261
- 3.950000,0.178261,0.178261
- 4.000000,0.178261,0.178261
+ 3.200000,0.178349,0.178349
+ 3.250000,0.178349,0.178349
+ 3.300000,0.178349,0.178349
+ 3.350000,0.178349,0.178349
+ 3.400000,0.178349,0.178349
+ 3.450000,0.178349,0.178349
+ 3.500000,0.178349,0.178349
+ 3.550000,0.178349,0.178349
+ 3.600000,0.178349,0.178349
+ 3.650000,0.178349,0.178349
+ 3.700000,0.178349,0.178349
+ 3.750000,0.178349,0.178349
+ 3.800000,0.178349,0.178349
+ 3.850000,0.178349,0.178349
+ 3.900000,0.178349,0.178349
+ 3.950000,0.178349,0.178349
+ 4.000000,0.178349,0.178349