Workaround pointless conversion in updateSealedTx

cardano-foundation · Nov 30, 2021 · 2d51f3c · 2d51f3c
1 parent 6289caa
commit 2d51f3c
Show file tree

Hide file tree

Showing 4 changed files with 17 additions and 13 deletions.
diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs
@@ -1631,7 +1631,7 @@ balanceTransaction
         { extraInputs
         , extraCollateral
         , extraOutputs
-        , newFee = const delta
+        , newFee = Just delta
         }
     let candidateMinFee = fromMaybe (Coin 0) $
             evaluateMinimumFee tl nodePParams candidateTx
@@ -1653,7 +1653,7 @@ balanceTransaction
         { extraInputs
         , extraCollateral
         , extraOutputs = mapFirst (txOutAddCoin surplus) extraOutputs
-        , newFee = const candidateMinFee
+        , newFee = Just candidateMinFee
         }
   where
     tl = ctx ^. transactionLayer @k

diff --git a/lib/core/src/Cardano/Wallet/Transaction.hs b/lib/core/src/Cardano/Wallet/Transaction.hs
@@ -230,7 +230,7 @@ data TxUpdate = TxUpdate
        -- ^ Only used in the Alonzo era and later. Will be silently ignored in
        -- previous eras.
     , extraOutputs :: [TxOut]
-    , newFee :: Coin -> Coin
+    , newFee :: Maybe Coin
         -- ^ Set the new fee, given the old one.
         --
         -- Note that you most likely won't care about the old fee at all. But it

diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs
@@ -586,7 +586,7 @@ mkDelegationCertificates da accXPub =
 --      == Right tx or Left
 -- @
 noTxUpdate :: TxUpdate
-noTxUpdate = TxUpdate [] [] [] id
+noTxUpdate = TxUpdate [] [] [] Nothing
 
 -- Used to add inputs and outputs when balancing a transaction.
 --
@@ -637,7 +637,7 @@ updateSealedTx (cardanoTx -> InAnyCardanoEra _era tx) extraContent = do
             -> ShelleyBasedEra era
             -> Ledger.TxBody (Cardano.ShelleyLedgerEra era)
             -> Ledger.TxBody (Cardano.ShelleyLedgerEra era)
-        adjustBody (TxUpdate extraInputs extraCollateral extraOutputs modifyFee) era body = case era of
+        adjustBody (TxUpdate extraInputs extraCollateral extraOutputs newFee) era body = case era of
             ShelleyBasedEraAlonzo -> body
                     { Alonzo.outputs = Alonzo.outputs body
                         <> StrictSeq.fromList (Cardano.toShelleyTxOut era <$> extraOutputs')
@@ -646,7 +646,7 @@ updateSealedTx (cardanoTx -> InAnyCardanoEra _era tx) extraContent = do
                     , Alonzo.collateral = Alonzo.collateral body
                         <> Set.fromList (Cardano.toShelleyTxIn <$> extraCollateral')
                     , Alonzo.txfee =
-                        modifyFee' $ Alonzo.txfee body
+                        modifyFee $ Alonzo.txfee body
                     }
             ShelleyBasedEraMary ->
                 let
@@ -659,7 +659,7 @@ updateSealedTx (cardanoTx -> InAnyCardanoEra _era tx) extraContent = do
                             <> StrictSeq.fromList (Cardano.toShelleyTxOut era <$> extraOutputs'))
                         certs
                         wdrls
-                        (modifyFee' txfee)
+                        (modifyFee txfee)
                         vldt
                         update
                         adHash
@@ -675,7 +675,7 @@ updateSealedTx (cardanoTx -> InAnyCardanoEra _era tx) extraContent = do
                             <> StrictSeq.fromList (Cardano.toShelleyTxOut era <$> extraOutputs'))
                         certs
                         wdrls
-                        (modifyFee' txfee)
+                        (modifyFee txfee)
                         vldt
                         update
                         adHash
@@ -691,28 +691,32 @@ updateSealedTx (cardanoTx -> InAnyCardanoEra _era tx) extraContent = do
                             <> StrictSeq.fromList (Cardano.toShelleyTxOut era <$> extraOutputs'))
                         certs
                         wdrls
-                        (modifyFee' txfee)
+                        (modifyFee txfee)
                         ttl
                         txUpdate
                         mdHash
           where
             extraInputs' = toCardanoTxIn . fst <$> extraInputs
             extraCollateral' = toCardanoTxIn <$> extraCollateral
             extraOutputs' = toCardanoTxOut era <$> extraOutputs
-            modifyFee' old = toLedgerCoin $ modifyFee $ fromLedgerCoin old
+
+            modifyFee old = case newFee of
+                Just new -> toLedgerCoin new
+                Nothing -> old
               where
                 toLedgerCoin :: Coin -> Ledger.Coin
                 toLedgerCoin (Coin c) =
                     Ledger.Coin (intCast c)
                 fromLedgerCoin :: Ledger.Coin -> Coin
                 fromLedgerCoin (Ledger.Coin c) =
                     Coin.unsafeFromIntegral c
-                    -- fromIntegral will throw "Exception: arithmetic underflow"
-                    -- if (c :: Integral) for some reason were to be negative.
 
     modifyLedgerTx _ (Byron.ByronTxBody _)
         = Left ErrByronTxNotSupported
 
+{-# ANN updateSealedTx ("HLint: replace case with maybe" :: T.Text) #-}
+
+
 -- NOTE / FIXME: This is an 'estimation' because it is actually quite hard to
 -- estimate what would be the cost of a selecting a particular input. Indeed, an
 -- input may contain any arbitrary assets, which has a direct impact on the

diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs
@@ -1477,7 +1477,7 @@ unsafeSealedTxFromHex =
 
 prop_updateSealedTx :: SealedTx -> [(TxIn, TxOut)] -> [TxIn] -> [TxOut] -> Coin -> Property
 prop_updateSealedTx tx extraIns extraCol extraOuts newFee = do
-    let extra = TxUpdate extraIns extraCol extraOuts (const newFee)
+    let extra = TxUpdate extraIns extraCol extraOuts (Just newFee)
     let tx' = either (error . show) id
             $ updateSealedTx tx extra
     conjoin