re-implement byron & jormungandr transaction layers accordingly

lib/byron/src/Cardano/Wallet/Byron/Transaction.hs

@@ -51,7 +51,7 @@ import Cardano.Wallet.Primitive.Types
     , TxOut (..)
     )
 import Cardano.Wallet.Transaction
-    ( Certificate (..)
+    ( DelegationAction
     , ErrDecodeSignedTx (..)
     , ErrMkTx (..)
     , TransactionLayer (..)
@@ -83,6 +83,7 @@ import GHC.Stack
 
 import qualified Cardano.Byron.Codec.Cbor as CBOR
 import qualified Cardano.Crypto.Wallet as CC
+import qualified Cardano.Wallet.Primitive.CoinSelection as CS
 import qualified Cardano.Wallet.Transaction as W
 import qualified Codec.CBOR.Encoding as CBOR
 import qualified Codec.CBOR.Read as CBOR
@@ -105,6 +106,7 @@ newTransactionLayer _proxy protocolMagic = TransactionLayer
     { mkStdTx = _mkStdTx
     , mkDelegationJoinTx = _mkDelegationJoinTx
     , mkDelegationQuitTx = _mkDelegationQuitTx
+    , initDelegationSelection = _initDelegationSelection
     , decodeSignedTx = _decodeSignedTx
     , minimumFee = _minimumFee
     , estimateMaxNumberOfInputs = _estimateMaxNumberOfInputs
@@ -136,11 +138,13 @@ newTransactionLayer _proxy protocolMagic = TransactionLayer
 
     _minimumFee
         :: FeePolicy
-        -> [Certificate]
+        -> Maybe DelegationAction
         -> CoinSelection
         -> Fee
-    _minimumFee policy _ (CoinSelection inps outs chngs _) =
-        computeFee $ sizeOfSignedTx (fst <$> inps) (outs <> map dummyOutput chngs)
+    _minimumFee policy _ cs =
+        computeFee $ sizeOfSignedTx
+            (fst <$> CS.inputs cs)
+            (CS.outputs cs <> map dummyOutput (CS.change cs))
       where
         dummyOutput :: Coin -> TxOut
         dummyOutput = TxOut (dummyAddress @n)
@@ -164,11 +168,9 @@ newTransactionLayer _proxy protocolMagic = TransactionLayer
     _validateSelection
         :: CoinSelection
         -> Either ErrValidateSelection ()
-    _validateSelection (CoinSelection _ outs _ rsv) = do
-        when (any (\ (TxOut _ c) -> c == Coin 0) outs) $
+    _validateSelection cs = do
+        when (any (\ (TxOut _ c) -> c == Coin 0) (CS.outputs cs)) $
             Left ErrInvalidTxOutAmount
-        when (isJust rsv) $
-            Left ErrReserveNotAllowed
 
     _decodeSignedTx
         :: ByteString
@@ -196,24 +198,21 @@ newTransactionLayer _proxy protocolMagic = TransactionLayer
     _mkDelegationQuitTx =
         notImplemented "mkDelegationQuitTx"
 
+    _initDelegationSelection =
+        notImplemented "initDelegationSelection"
+
 --------------------------------------------------------------------------------
 -- Extra validations on coin selection
 --
 
 data ErrValidateSelection
     = ErrInvalidTxOutAmount
     -- ^ Transaction with 0 output amount is tried
-    | ErrReserveNotAllowed
-    -- ^ Transaction has a reserve input amount, not allowed for this backend
 
 instance Buildable ErrValidateSelection where
     build = \case
         ErrInvalidTxOutAmount ->
             "Invalid coin selection: at least one output is null."
-        ErrReserveNotAllowed -> build $ T.unwords
-            [ "The given coin selection was given a reserve amount and this is"
-            , "not allowed for this backend / era."
-            ]
 
 type instance W.ErrValidateSelection (IO Byron) = ErrValidateSelection
 

lib/byron/test/unit/Cardano/Wallet/Byron/TransactionSpec.hs

@@ -128,7 +128,7 @@ spec = do
     describe "Coin Selection w/ Byron" $ do
         it "REG #1561 - Correct balancing of amounts close to the limit" $ do
             let opts = FeeOptions
-                    { estimateFee = minimumFee tlayer feePolicy []
+                    { estimateFee = minimumFee tlayer feePolicy Nothing
                     , dustThreshold = minBound
                     , onDanglingChange = SaveMoney
                     }
@@ -140,7 +140,7 @@ spec = do
 
             let addr = Address "fake-address"
             let utxo = UTxO mempty
-            let csel = CoinSelection
+            let csel = mempty
                     { inputs =
                         [ ( TxIn (Hash "0") 0
                           , TxOut addr (Coin 1_000_000)
@@ -151,8 +151,6 @@ spec = do
                         ]
                     , change =
                         [Coin 30_556]
-                    , reserve =
-                        Nothing
                     }
 
             runExceptT (adjustForFee opts utxo csel) >>= \case
@@ -317,14 +315,14 @@ propSizeEstimation pm genSel genChngAddrs =
     estimateSize :: TransactionLayer t k -> CoinSelection -> Quantity "bytes" Int
     estimateSize tl sel =
         let
-            Fee fee = minimumFee tl idPolicy [] sel
+            Fee fee = minimumFee tl idPolicy Nothing sel
         in
             Quantity $ fromIntegral fee
       where
         idPolicy = LinearFee (Quantity 0) (Quantity 1) (Quantity 0)
 
     fromCoinSelection :: CoinSelection -> [Address] -> CBOR.Encoding
-    fromCoinSelection (CoinSelection inps outs chngs _) chngAddrs =
+    fromCoinSelection (CoinSelection inps _ _ outs chngs _) chngAddrs =
         CBOR.encodeSignedTx (fst <$> inps, outs <> outs') wits
       where
         dummySig =
@@ -403,7 +401,7 @@ genSelection = do
         }
 
 shrinkSelection :: CoinSelection -> [CoinSelection]
-shrinkSelection sel@(CoinSelection inps outs chgs rsv) = case (inps, outs, chgs) of
+shrinkSelection sel@(CoinSelection inps _ _ outs chgs _) = case (inps, outs, chgs) of
     ([_], [_], []) ->
         []
     _ ->
@@ -416,25 +414,24 @@ shrinkSelection sel@(CoinSelection inps outs chgs rsv) = case (inps, outs, chgs)
             chgs'' = drop 1 chgs
         in
             filter (\s -> s /= sel && isValidSelection s)
-                [ CoinSelection inps' outs' chgs' rsv
-                , CoinSelection inps' outs chgs rsv
-                , CoinSelection inps outs chgs' rsv
-                , CoinSelection inps outs' chgs rsv
-                , CoinSelection inps'' outs'' chgs'' rsv
-                , CoinSelection inps'' outs chgs rsv
-                , CoinSelection inps outs'' chgs rsv
-                , CoinSelection inps outs chgs'' rsv
+                [ mempty { inputs = inps' , outputs = outs' , change = chgs'  }
+                , mempty { inputs = inps' , outputs = outs  , change = chgs   }
+                , mempty { inputs = inps  , outputs = outs  , change = chgs'  }
+                , mempty { inputs = inps  , outputs = outs' , change = chgs   }
+                , mempty { inputs = inps'', outputs = outs'', change = chgs'' }
+                , mempty { inputs = inps'', outputs = outs  , change = chgs   }
+                , mempty { inputs = inps  , outputs = outs'', change = chgs   }
+                , mempty { inputs = inps  , outputs = outs  , change = chgs'' }
                 ]
 
 isValidSelection :: CoinSelection -> Bool
-isValidSelection (CoinSelection i o c r) =
+isValidSelection (CoinSelection i _ _ o c _) =
     let
         oAmt = sum $ map (fromIntegral . getCoin . coin) o
         cAmt = sum $ map (fromIntegral . getCoin) c
         iAmt = sum $ map (fromIntegral . getCoin . coin . snd) i
-        rAmt = maybe (0 :: Integer) (fromIntegral . getCoin) r
     in
-        iAmt + rAmt >= oAmt + cAmt
+        (iAmt :: Integer) >= oAmt + cAmt
 
 genTxIn :: Gen TxIn
 genTxIn = TxIn

lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs

@@ -48,7 +48,7 @@ import Cardano.Wallet.Primitive.Fee
 import Cardano.Wallet.Primitive.Types
     ( ChimericAccount (..), Hash (..), SealedTx (..), Tx (..), TxOut (..) )
 import Cardano.Wallet.Transaction
-    ( Certificate (..)
+    ( DelegationAction (..)
     , ErrDecodeSignedTx (..)
     , ErrMkTx (..)
     , TransactionLayer (..)
@@ -68,6 +68,7 @@ import Data.Text.Class
 import Fmt
     ( Buildable (..) )
 
+import qualified Cardano.Wallet.Primitive.CoinSelection as CS
 import qualified Cardano.Wallet.Transaction as W
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.Text as T
@@ -87,25 +88,27 @@ newTransactionLayer block0H = TransactionLayer
             ( MkFragmentSimpleTransaction (txWitnessTagFor @k)
             ) keyFrom inps outs
 
-    , mkDelegationJoinTx = \_ _ pool accXPrv keyFrom _ inps outs chgs ->
+    , mkDelegationJoinTx = \pool accXPrv keyFrom _ cs ->
         let acc = ChimericAccount . xpubPublicKey . getRawKey . publicKey . fst $ accXPrv
         in mkFragment
             ( MkFragmentStakeDelegation
                 (txWitnessTagFor @k)
                 (DlgFull pool)
                 acc
                 (first getRawKey accXPrv)
-            ) keyFrom inps (outs ++ chgs)
+            ) keyFrom (CS.inputs cs) (CS.outputs cs)
 
-    , mkDelegationQuitTx = \_ accXPrv keyFrom _ inps outs chgs ->
+    , mkDelegationQuitTx = \accXPrv keyFrom _ cs ->
         let acc = ChimericAccount . xpubPublicKey . getRawKey . publicKey . fst $ accXPrv
         in mkFragment
             ( MkFragmentStakeDelegation
                 (txWitnessTagFor @k)
                 DlgNone
                 acc
                 (first getRawKey accXPrv)
-            ) keyFrom inps (outs ++ chgs)
+            ) keyFrom (CS.inputs cs) (CS.outputs cs)
+
+    , initDelegationSelection = const mempty
 
     , decodeSignedTx = \payload -> do
         let errInvalidPayload =
@@ -120,11 +123,11 @@ newTransactionLayer block0H = TransactionLayer
 
     , estimateMaxNumberOfInputs = \_ _ -> fromIntegral maxNumberOfInputs
 
-    , validateSelection = \(CoinSelection inps outs _ rsv) -> do
-        when (length inps > maxNumberOfInputs || length outs > maxNumberOfOutputs)
+    , validateSelection = \cs -> do
+        let tooManyInputs  = length (CS.inputs cs)  > maxNumberOfInputs
+        let tooManyOutputs = length (CS.outputs cs) > maxNumberOfOutputs
+        when (tooManyInputs || tooManyOutputs)
             $ Left ErrExceededInpsOrOuts
-        when (isJust rsv)
-            $ Left ErrReserveNotAllowed
 
     , allowUnbalancedTx = False
     }
@@ -152,15 +155,15 @@ newTransactionLayer block0H = TransactionLayer
     -- is multiplied by the total number of inputs and outputs.
     _minimumFee
         :: FeePolicy
-        -> [Certificate]
+        -> Maybe DelegationAction
         -> CoinSelection
         -> Fee
-    _minimumFee policy certs (CoinSelection inps outs chgs _) =
-        Fee $ ceiling (a + b*fromIntegral ios + c*fromIntegral cs)
+    _minimumFee policy action cs =
+        Fee $ ceiling (a + b*fromIntegral ios + c*certs)
       where
         LinearFee (Quantity a) (Quantity b) (Quantity c) = policy
-        cs  = length $ filter (/= KeyRegistrationCertificate) certs
-        ios = length inps + length outs + length chgs
+        certs = if isJust action then 1 else 0
+        ios = length (CS.inputs cs) + length (CS.outputs cs) + length (CS.change cs)
 
 -- | Provide a transaction witness for a given private key. The type of witness
 -- is different between types of keys and, with backward-compatible support, we
@@ -184,8 +187,6 @@ instance TxWitnessTagFor ByronKey       where txWitnessTagFor = TxWitnessLegacyU
 data ErrValidateSelection
     = ErrExceededInpsOrOuts
         -- ^ Transaction with improper number of inputs and outputs is tried
-    | ErrReserveNotAllowed
-        -- ^ Transaction has a reserve input amount, not allowed for this backend
     deriving (Eq, Show)
 
 instance Buildable ErrValidateSelection where
@@ -194,10 +195,6 @@ instance Buildable ErrValidateSelection where
             [ "I can't validate coin selection because either the number of inputs"
             , "is more than", maxI, "or the number of outputs exceeds", maxO <> "."
             ]
-        ErrReserveNotAllowed -> build $ T.unwords
-            [ "The given coin selection was given a reserve amount and this is"
-            , "not allowed for this backend / era."
-            ]
       where
         maxI = toText maxNumberOfInputs
         maxO = toText maxNumberOfOutputs

lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/TransactionSpec.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -42,8 +43,6 @@ import Cardano.Wallet.Primitive.Types
     , SlotId (..)
     , TxIn (..)
     , TxOut (..)
-    , WalletDelegation (..)
-    , WalletDelegationStatus (..)
     )
 import Cardano.Wallet.Transaction
     ( ErrMkTx (..), TransactionLayer (..) )
@@ -519,26 +518,20 @@ goldenTestDelegationCertTx
     -> [TxOut]
     -> ByteString
     -> SpecWith ()
-goldenTestDelegationCertTx tl keystore pool (accountXPrv, pass) inps outs bytes' = it title $ do
-    let walDelegs = WalletDelegation NotDelegating []
+goldenTestDelegationCertTx tl keystore pool (accountXPrv, pass) inputs outputs bytes' = it title $ do
     let res = mkDelegationJoinTx tl
-            policy
-            walDelegs
             pool
             (accountXPrv, pass)
             keystore
             (SlotId 0 0)
-            inps
-            outs
-            []
+            (mempty { inputs, outputs })
     let sealed = getSealedTx . snd <$> res
     sealed `shouldBe` Right (unsafeFromHex bytes')
     & counterexample ("poolId = " <> showHex (getPoolId pool))
   where
     title = "golden test mkCertificateTx: " <> show pool
-        <> show inps <> show outs
+        <> show inputs <> show outputs
     showHex = B8.unpack . hex
-    policy = error "fee policy unused by Jörmungandr"
 
 xprvSeqFromSeed
     :: ByteString
@@ -602,15 +595,15 @@ tooNumerousInpsTest
 tooNumerousInpsTest _ block0 = it title $ do
     let addr = paymentAddress @n $ publicKey $ fst $
             xprvSeqFromSeed "address-number-0"
-    let res = validateSelection tl (CoinSelection inps outs chngs Nothing)
+    let res = validateSelection tl $ mempty { inputs, outputs, change }
           where
             tl = newTransactionLayer @JormungandrKey block0
-            inps = replicate 256
+            inputs = replicate 256
                 ( TxIn (Hash "arbitrary") 0
                 , TxOut addr (Coin 1)
                 )
-            outs = []
-            chngs = []
+            outputs = []
+            change  = []
     res `shouldBe` Left ErrExceededInpsOrOuts
   where
     title = "Too numerous inputs yields an error ("
@@ -625,15 +618,15 @@ tooNumerousOutsTest
 tooNumerousOutsTest _ block0 = it title $ do
     let addr = paymentAddress @n $ publicKey $ fst $
             xprvSeqFromSeed "address-number-0"
-    let res = validateSelection tl (CoinSelection inps outs chngs Nothing)
+    let res = validateSelection tl $ mempty { inputs, outputs, change }
           where
             tl = newTransactionLayer @JormungandrKey block0
-            inps = replicate 255
+            inputs = replicate 255
                 ( TxIn (Hash "arbitrary") 0
                 , TxOut addr (Coin 10)
                 )
-            outs = replicate 256 (TxOut addr (Coin 9))
-            chngs = replicate 256 (Coin 9)
+            outputs = replicate 256 (TxOut addr (Coin 9))
+            change  = replicate 256 (Coin 9)
     res `shouldBe` Left ErrExceededInpsOrOuts
   where
     title = "Too numerous outputs yields an error ("