introduce 'defaultTransactionCtx' to avoid repetition of empty contex…

…ts in various situation
cardano-foundation · Jan 28, 2021 · e536335 · e536335
1 parent a3f918d
commit e536335
Show file tree

Hide file tree

Showing 5 changed files with 31 additions and 41 deletions.
diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs
@@ -332,6 +332,7 @@ import Cardano.Wallet.Transaction
     , ErrMkTx (..)
     , TransactionCtx (..)
     , TransactionLayer (..)
+    , defaultTransactionCtx
     )
 import Control.DeepSeq
     ( NFData )
@@ -949,12 +950,8 @@ readNextWithdrawal ctx wid (Coin withdrawal) = db & \DBLayer{..} -> do
     tl = ctx ^. transactionLayer @k
     nl = ctx ^. networkLayer
 
-    mkTxCtx txWithdrawal = TransactionCtx
-        { txWithdrawal
-        , txMetadata = Nothing
-        , txTimeToLive = maxBound
-        , txDelegationAction = Nothing
-        }
+    mkTxCtx txWithdrawal =
+        defaultTransactionCtx { txWithdrawal }
 
 
 readRewardAccount

diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs
@@ -339,7 +339,11 @@ import Cardano.Wallet.Registry
     , workerResource
     )
 import Cardano.Wallet.Transaction
-    ( DelegationAction (..), TransactionCtx (..), TransactionLayer )
+    ( DelegationAction (..)
+    , TransactionCtx (..)
+    , TransactionLayer
+    , defaultTransactionCtx
+    )
 import Cardano.Wallet.Unsafe
     ( unsafeRunExceptT )
 import Control.Arrow
@@ -1176,12 +1180,7 @@ selectCoins ctx genChange (ApiT wid) body = do
         --
         -- TODO 2:
         -- Allow passing around metadata as part of external coin selections.
-        let txCtx = TransactionCtx
-                { txWithdrawal = Coin 0
-                , txMetadata = Nothing
-                , txTimeToLive = maxBound
-                , txDelegationAction = Nothing
-                }
+        let txCtx = defaultTransactionCtx
         let outs = coerceCoin <$> body ^. #payments
 
         let transform = \s sel ->
@@ -1222,10 +1221,8 @@ selectCoinsForJoin ctx knownPools getPoolStatus pid wid = do
             $ W.joinStakePool @_ @s @k @n wrk curEpoch pools pid poolStatus wid
 
         (wdrl, _mkRwdAcct) <- mkRewardAccountBuilder @_ @s @k @n ctx wid Nothing
-        let txCtx = TransactionCtx
+        let txCtx = defaultTransactionCtx
                 { txWithdrawal = wdrl
-                , txMetadata = Nothing
-                , txTimeToLive = maxBound
                 , txDelegationAction = Just action
                 }
 
@@ -1260,10 +1257,8 @@ selectCoinsForQuit ctx (ApiT wid) = do
             $ W.quitStakePool @_ @s @k @n wrk wid
 
         (wdrl, _mkRwdAcct) <- mkRewardAccountBuilder @_ @s @k @n ctx wid Nothing
-        let txCtx = TransactionCtx
+        let txCtx = defaultTransactionCtx
                 { txWithdrawal = wdrl
-                , txMetadata = Nothing
-                , txTimeToLive = maxBound
                 , txDelegationAction = Just action
                 }
 
@@ -1423,11 +1418,10 @@ postTransaction ctx genChange (ApiT wid) body = do
         mkRewardAccountBuilder @_ @s @_ @n ctx wid (body ^. #withdrawal)
 
     ttl <- liftIO $ W.getTxExpiry ti mTTL
-    let txCtx = TransactionCtx
+    let txCtx = defaultTransactionCtx
             { txWithdrawal = wdrl
             , txMetadata = md
             , txTimeToLive = ttl
-            , txDelegationAction = Nothing
             }
 
     (sel, tx, txMeta, txTime) <- withWorkerCtx ctx wid liftE liftE $ \wrk -> do
@@ -1531,11 +1525,9 @@ postTransactionFee
     -> Handler ApiFee
 postTransactionFee ctx (ApiT wid) body = do
     (wdrl, _) <- mkRewardAccountBuilder @_ @s @_ @n ctx wid Nothing
-    let txCtx = TransactionCtx
+    let txCtx = defaultTransactionCtx
             { txWithdrawal = wdrl
             , txMetadata = getApiT <$> body ^. #metadata
-            , txTimeToLive = maxBound
-            , txDelegationAction = Nothing
             }
     withWorkerCtx ctx wid liftE liftE $ \wrk -> do
         let runSelection = W.selectAssets @_ @s @k wrk wid txCtx outs getFee
@@ -1582,9 +1574,8 @@ joinStakePool ctx knownPools getPoolStatus apiPoolId (ApiT wid) body = do
 
         (wdrl, mkRwdAcct) <- mkRewardAccountBuilder @_ @s @_ @n ctx wid Nothing
         ttl <- liftIO $ W.getTxExpiry ti Nothing
-        let txCtx = TransactionCtx
+        let txCtx = defaultTransactionCtx
                 { txWithdrawal = wdrl
-                , txMetadata = Nothing
                 , txTimeToLive = ttl
                 , txDelegationAction = Just action
                 }
@@ -1631,12 +1622,7 @@ delegationFee ctx (ApiT wid) = do
             <*> W.estimateFee runSelection
   where
     txCtx :: TransactionCtx
-    txCtx = TransactionCtx
-        { txWithdrawal = Coin 0
-        , txMetadata = Nothing
-        , txTimeToLive = maxBound
-        , txDelegationAction = Nothing
-        }
+    txCtx = defaultTransactionCtx
 
 quitStakePool
     :: forall ctx s n k.
@@ -1665,9 +1651,8 @@ quitStakePool ctx (ApiT wid) body = do
 
         (wdrl, mkRwdAcct) <- mkRewardAccountBuilder @_ @s @_ @n ctx wid Nothing
         ttl <- liftIO $ W.getTxExpiry ti Nothing
-        let txCtx = TransactionCtx
+        let txCtx = defaultTransactionCtx
                 { txWithdrawal = wdrl
-                , txMetadata = Nothing
                 , txTimeToLive = ttl
                 , txDelegationAction = Just action
                 }

diff --git a/lib/core/src/Cardano/Wallet/Transaction.hs b/lib/core/src/Cardano/Wallet/Transaction.hs
@@ -20,6 +20,7 @@ module Cardano.Wallet.Transaction
       TransactionLayer (..)
     , DelegationAction (..)
     , TransactionCtx (..)
+    , defaultTransactionCtx
 
     -- * Errors
     , ErrMkTx (..)
@@ -146,6 +147,16 @@ data TransactionCtx = TransactionCtx
     -- ^ An additional delegation to take.
     } deriving (Show, Eq)
 
+-- | A default context with sensible placeholder. Can be used to reduce
+-- repetition for changing only sub-part of the default context.
+defaultTransactionCtx :: TransactionCtx
+defaultTransactionCtx = TransactionCtx
+    { txWithdrawal = Coin 0
+    , txMetadata = Nothing
+    , txTimeToLive = maxBound
+    , txDelegationAction = Nothing
+    }
+
 -- | Whether the user is attempting any particular delegation action.
 data DelegationAction = RegisterKeyAndJoin PoolId | Join PoolId | Quit
     deriving (Show, Eq, Generic)

diff --git a/lib/core/test/unit/Cardano/WalletSpec.hs b/lib/core/test/unit/Cardano/WalletSpec.hs
@@ -108,7 +108,7 @@ import Cardano.Wallet.Primitive.Types.Tx
 import Cardano.Wallet.Primitive.Types.UTxO
     ( UTxO (..) )
 import Cardano.Wallet.Transaction
-    ( ErrMkTx (..), TransactionCtx (..), TransactionLayer (..) )
+    ( ErrMkTx (..), TransactionLayer (..), defaultTransactionCtx )
 import Cardano.Wallet.Unsafe
     ( unsafeRunExceptT )
 import Control.Arrow
@@ -541,12 +541,7 @@ walletKeyIsReencrypted (wid, wname) (xprv, pwd) newPwd =
             UTxOIndex.empty
         }
 
-    ctx = TransactionCtx
-        { txWithdrawal = Coin 0
-        , txMetadata = Nothing
-        , txTimeToLive = maxBound
-        , txDelegationAction = Nothing
-        }
+    ctx = defaultTransactionCtx
 
 walletListTransactionsSorted
     :: (WalletId, WalletName, DummyState)

diff --git a/lib/shelley/bench/Restore.hs b/lib/shelley/bench/Restore.hs
@@ -140,6 +140,8 @@ import Cardano.Wallet.Shelley.Network
     ( withNetworkLayer )
 import Cardano.Wallet.Shelley.Transaction
     ( TxWitnessTagFor (..), newTransactionLayer )
+import Cardano.Wallet.Transaction
+    ( defaultTransactionCtx )
 import Cardano.Wallet.Unsafe
     ( unsafeMkEntropy, unsafeMkPercentage, unsafeRunExceptT )
 import Control.Arrow