adjust decodeTx in shelley and other things accordingly

lib/core/src/Cardano/Wallet.hs

@@ -1574,7 +1574,7 @@ balanceTransaction
                 <$> L.find (\(i',_) -> i == i') (extraInputs update)
 
     extractFromTx tx =
-        let (Tx _id _fee _coll _inps outs wdrlMap meta _vldt, toMint, toBurn)
+        let (Tx _id _fee _coll _inps outs wdrlMap meta _vldt, toMint, toBurn, _)
                 = decodeTx tl tx
             -- TODO: Find a better abstraction that can cover this case.
             wdrl = WithdrawalSelf
@@ -1604,7 +1604,7 @@ balanceTransaction
         -> TransactionCtx
     padFeeEstimation sealedTx txCtx =
         let
-            (walletTx, _, _) = decodeTx tl sealedTx
+            (walletTx, _, _, _) = decodeTx tl sealedTx
             worseEstimate = calcMinimumCost tl pp txCtx skeleton
             skeleton = SelectionSkeleton
                 { skeletonInputCount = length (view #resolvedInputs walletTx)
@@ -2146,7 +2146,7 @@ submitExternalTx ctx sealedTx = traceResult trPost $ do
     tl = ctx ^. transactionLayer @k
     nw = ctx ^. networkLayer
     trPost = contramap (MsgSubmitExternalTx (tx ^. #txId)) (ctx ^. logger)
-    (tx, _, _) = decodeTx tl sealedTx
+    (tx, _, _, _) = decodeTx tl sealedTx
 
 -- | Remove a pending or expired transaction from the transaction history. This
 -- happens at the request of the user. If the transaction is already on chain,

lib/core/src/Cardano/Wallet/Api/Server.hs

@@ -2211,7 +2211,7 @@ decodeTransaction
     -> ApiSerialisedTransaction
     -> Handler (ApiDecodedTransaction n)
 decodeTransaction ctx (ApiT wid) (ApiSerialisedTransaction (ApiT sealed)) = do
-    let (Tx txid feeM colls inps outs wdrlMap meta vldt, toMint, toBurn) = decodeTx tl sealed
+    let (Tx txid feeM colls inps outs wdrlMap meta vldt, toMint, toBurn, _certs) = decodeTx tl sealed
     (txinsOutsPaths, collsOutsPaths, outsPath, acct)  <-
         withWorkerCtx ctx wid liftE liftE $ \wrk -> do
           (acct, _, _) <- liftHandler $ W.readRewardAccount @_ @s @k @n wrk wid

lib/core/src/Cardano/Wallet/Primitive/Types.hs

@@ -53,6 +53,7 @@ module Cardano.Wallet.Primitive.Types
     , getPoolRetirementCertificate
 
     , NonWalletCertificate (..)
+    , Certificates
 
     -- * Network Parameters
     , NetworkParameters (..)
@@ -1433,6 +1434,9 @@ data NonWalletCertificate
 
 instance NFData NonWalletCertificate
 
+type Certificates =
+    ([DelegationCertificate], [PoolCertificate], [NonWalletCertificate])
+
 -- | Represents an abstract notion of a certificate publication time.
 --
 -- Certificates published at later times take precedence over certificates

lib/core/src/Cardano/Wallet/Transaction.hs

@@ -51,7 +51,8 @@ import Cardano.Wallet.Primitive.CoinSelection.Balance
 import Cardano.Wallet.Primitive.Slotting
     ( PastHorizonException, TimeInterpreter )
 import Cardano.Wallet.Primitive.Types
-    ( PoolId
+    ( Certificates
+    , PoolId
     , ProtocolParameters
     , SlotNo (..)
     , TokenBundleMaxSize (..)
@@ -199,7 +200,7 @@ data TransactionLayer k tx = TransactionLayer
         -> TxConstraints
         -- The set of constraints that apply to all transactions.
 
-    , decodeTx :: tx -> (Tx, TokenMap, TokenMap)
+    , decodeTx :: tx -> (Tx, TokenMap, TokenMap, Certificates)
     -- ^ Decode an externally-created transaction.
 
     , updateTx

lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs

@@ -196,7 +196,8 @@ import Cardano.Wallet.Byron.Compatibility
 import Cardano.Wallet.Primitive.AddressDerivation
     ( NetworkDiscriminant (..) )
 import Cardano.Wallet.Primitive.Types
-    ( ChainPoint (..)
+    ( Certificates
+    , ChainPoint (..)
     , MinimumUTxOValue (..)
     , PoolCertificate (..)
     , PoolRegistrationCertificate (..)
@@ -247,7 +248,7 @@ import Data.Function
 import Data.IntCast
     ( intCast )
 import Data.List
-    ( unzip5 )
+    ( unzip6 )
 import Data.Map.Strict
     ( Map )
 import Data.Maybe
@@ -501,7 +502,7 @@ fromShelleyBlock
     -> (W.Block, [W.PoolCertificate])
 fromShelleyBlock gp blk@(ShelleyBlock (SL.Block _ (SL.TxSeq txs')) _) =
     let
-       (txs, dlgCerts, poolCerts, _, _) = unzip5 $ map fromShelleyTx $ toList txs'
+       (txs, dlgCerts, poolCerts, _, _, _) = unzip6 $ map fromShelleyTx $ toList txs'
     in
         ( W.Block
             { header = toShelleyBlockHeader (W.getGenesisBlockHash gp) blk
@@ -517,7 +518,7 @@ fromAllegraBlock
     -> (W.Block, [W.PoolCertificate])
 fromAllegraBlock gp blk@(ShelleyBlock (SL.Block _ (SL.TxSeq txs')) _) =
     let
-       (txs, dlgCerts, poolCerts, _, _) = unzip5 $ map fromAllegraTx $ toList txs'
+       (txs, dlgCerts, poolCerts, _, _, _) = unzip6 $ map fromAllegraTx $ toList txs'
     in
         ( W.Block
             { header = toShelleyBlockHeader (W.getGenesisBlockHash gp) blk
@@ -533,7 +534,7 @@ fromMaryBlock
     -> (W.Block, [W.PoolCertificate])
 fromMaryBlock gp blk@(ShelleyBlock (SL.Block _ (SL.TxSeq txs')) _) =
     let
-       (txs, dlgCerts, poolCerts, _, _) = unzip5 $ map fromMaryTx $ toList txs'
+       (txs, dlgCerts, poolCerts, _, _, _) = unzip6 $ map fromMaryTx $ toList txs'
     in
         ( W.Block
             { header = toShelleyBlockHeader (W.getGenesisBlockHash gp) blk
@@ -557,7 +558,7 @@ fromAlonzoBlock
 fromAlonzoBlock gp blk@(ShelleyBlock (SL.Block _ txSeq) _) =
     let
         Alonzo.TxSeq txs' = txSeq
-        (txs, dlgCerts, poolCerts, _, _) = unzip5 $ map fromAlonzoValidatedTx $ toList txs'
+        (txs, dlgCerts, poolCerts, _, _, _) = unzip6 $ map fromAlonzoValidatedTx $ toList txs'
     in
         ( W.Block
             { header = toShelleyBlockHeader (W.getGenesisBlockHash gp) blk
@@ -1281,23 +1282,24 @@ fromShelleyCoin (SL.Coin c) = Coin.unsafeFromIntegral c
 toShelleyCoin :: W.Coin -> SL.Coin
 toShelleyCoin (W.Coin c) = SL.Coin $ intCast c
 
-fromCardanoTx :: Cardano.Tx era -> (W.Tx, TokenMap, TokenMap)
+fromCardanoTx :: Cardano.Tx era -> (W.Tx, TokenMap, TokenMap, Certificates)
 fromCardanoTx = \case
     Cardano.ShelleyTx era tx -> case era of
         Cardano.ShelleyBasedEraShelley -> extract $ fromShelleyTx tx
         Cardano.ShelleyBasedEraAllegra -> extract $ fromAllegraTx tx
         Cardano.ShelleyBasedEraMary    -> extract $ fromMaryTx tx
         Cardano.ShelleyBasedEraAlonzo  -> extract $ fromAlonzoTx tx
-    Cardano.ByronTx tx                 -> (fromTxAux tx, mempty, mempty)
+    Cardano.ByronTx tx                 -> (fromTxAux tx, mempty, mempty, ([],[],[]))
   where
-    extract (a,_b,_c,d,e) = (a,d,e)
+    extract (a, b1, b2, b3, c,d) = (a,c,d, (b1,b2,b3))
 
 -- NOTE: For resolved inputs we have to pass in a dummy value of 0.
 fromShelleyTx
     :: SLAPI.Tx (Cardano.ShelleyLedgerEra ShelleyEra)
     -> ( W.Tx
        , [W.DelegationCertificate]
        , [W.PoolCertificate]
+       , [W.NonWalletCertificate]
        , TokenMap
        , TokenMap
        )
@@ -1322,6 +1324,7 @@ fromShelleyTx tx =
         }
     , mapMaybe fromShelleyDelegationCert (toList certs)
     , mapMaybe fromShelleyRegistrationCert (toList certs)
+    , mapMaybe fromShelleyOtherCert (toList certs)
     , mempty
     , mempty
     )
@@ -1333,6 +1336,7 @@ fromAllegraTx
     -> ( W.Tx
        , [W.DelegationCertificate]
        , [W.PoolCertificate]
+       , [W.NonWalletCertificate]
        , TokenMap
        , TokenMap
        )
@@ -1358,6 +1362,7 @@ fromAllegraTx tx =
         }
     , mapMaybe fromShelleyDelegationCert (toList certs)
     , mapMaybe fromShelleyRegistrationCert (toList certs)
+    , mapMaybe fromShelleyOtherCert (toList certs)
     , mempty
     , mempty
     )
@@ -1374,6 +1379,7 @@ fromMaryTx
     -> ( W.Tx
        , [W.DelegationCertificate]
        , [W.PoolCertificate]
+       , [W.NonWalletCertificate]
        , TokenMap
        , TokenMap
        )
@@ -1398,6 +1404,7 @@ fromMaryTx tx =
         }
     , mapMaybe fromShelleyDelegationCert (toList certs)
     , mapMaybe fromShelleyRegistrationCert (toList certs)
+    , mapMaybe fromShelleyOtherCert (toList certs)
     , assetsToMint
     , assetsToBurn
     )
@@ -1424,6 +1431,7 @@ fromAlonzoTxBodyAndAux
     -> ( W.Tx
        , [W.DelegationCertificate]
        , [W.PoolCertificate]
+       , [W.NonWalletCertificate]
        , TokenMap
        , TokenMap
        )
@@ -1448,6 +1456,7 @@ fromAlonzoTxBodyAndAux bod mad =
         }
     , mapMaybe fromShelleyDelegationCert (toList certs)
     , mapMaybe fromShelleyRegistrationCert (toList certs)
+    , mapMaybe fromShelleyOtherCert (toList certs)
     , assetsToMint
     , assetsToBurn
     )
@@ -1483,6 +1492,7 @@ fromAlonzoValidatedTx
     -> ( W.Tx
        , [W.DelegationCertificate]
        , [W.PoolCertificate]
+       , [W.NonWalletCertificate]
        , TokenMap
        , TokenMap
        )
@@ -1494,11 +1504,12 @@ fromAlonzoTx
     -> ( W.Tx
        , [W.DelegationCertificate]
        , [W.PoolCertificate]
+       , [W.NonWalletCertificate]
        , TokenMap
        , TokenMap
        )
 fromAlonzoTx (Alonzo.ValidatedTx bod _wits (Alonzo.IsValid isValid) aux) =
-    (\(tx, d, p, m, b) -> (tx { W.scriptValidity = validity }, d, p, m, b))
+    (\(tx, d, p, c, m, b) -> (tx { W.scriptValidity = validity }, d, p, c, m, b))
     $ fromAlonzoTxBodyAndAux bod aux
     where
         validity =
@@ -1592,6 +1603,15 @@ fromShelleyRegistrationCert = \case
     SL.DCertGenesis{} -> Nothing
     SL.DCertMir{}     -> Nothing
 
+fromShelleyOtherCert
+    :: SL.DCert crypto
+    -> Maybe (W.NonWalletCertificate)
+fromShelleyOtherCert = \case
+    SL.DCertPool _ -> Nothing
+    SL.DCertDeleg{}   -> Nothing
+    SL.DCertGenesis{} -> Just W.GenesisCertificate
+    SL.DCertMir{}     -> Just W.MIRCertificate
+
 toWalletCoin :: HasCallStack => SL.Coin -> W.Coin
 toWalletCoin (SL.Coin c) = Coin.unsafeFromIntegral c
 

lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs

@@ -94,7 +94,8 @@ import Cardano.Wallet.Primitive.CoinSelection.Balance
 import Cardano.Wallet.Primitive.Slotting
     ( PastHorizonException, TimeInterpreter, getSystemStart, toEpochInfo )
 import Cardano.Wallet.Primitive.Types
-    ( ExecutionUnitPrices (..)
+    ( Certificates
+    , ExecutionUnitPrices (..)
     , ExecutionUnits (..)
     , FeePolicy (..)
     , ProtocolParameters (..)
@@ -354,7 +355,7 @@ mkTx networkId payload ttl (rewardAcnt, pwdAcnt) addrResolver wdrl cs fees era =
     let signed = signTransaction networkId acctResolver addrResolver inputResolver
             (unsigned, mkExtraWits unsigned)
 
-    let withResolvedInputs (tx, _, _) = tx
+    let withResolvedInputs (tx, _, _, _) = tx
             { resolvedInputs = second txOutCoin <$> F.toList (view #inputs cs)
             }
     Right ( withResolvedInputs (fromCardanoTx signed)
@@ -560,7 +561,7 @@ newTransactionLayer networkId = TransactionLayer
     , updateTx = updateSealedTx
     }
 
-_decodeSealedTx :: SealedTx -> (Tx, TokenMap, TokenMap)
+_decodeSealedTx :: SealedTx -> (Tx, TokenMap, TokenMap, Certificates)
 _decodeSealedTx (cardanoTx -> InAnyCardanoEra _era tx) = fromCardanoTx tx
 
 mkDelegationCertificates