Drop class TxWitnessTagFor (#4050)

- [x] Replace the `TxWitnessTagFor` class with a function
`WitnessTagForKey :: KeyFlavorS a -> TxWitnessTag`

### Motivation

This will allow the `TxWitnessTag` module to be moved into the
`cardano-balance-tx` library. The class used to depend on `Depth`. We
can remove `TxWitnessTag` from the wallet/balanceTx interface at a later
stage.

<!-- Additional comments, links, or screenshots to attach, if any. -->

### Issue Number

ADP-3081

lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs

@@ -191,6 +191,7 @@ import Cardano.Wallet
     , readPrivateKey
     , readWalletMeta
     , transactionLayer
+    , txWitnessTagForKey
     , utxoAssumptionsForWallet
     )
 import Cardano.Wallet.Address.Book
@@ -538,7 +539,7 @@ import Cardano.Wallet.Registry
 import Cardano.Wallet.Shelley.Compatibility.Ledger
     ( toLedger )
 import Cardano.Wallet.Shelley.Transaction
-    ( TxWitnessTag, TxWitnessTagFor (..) )
+    ( TxWitnessTag )
 import Cardano.Wallet.TokenMetadata
     ( TokenMetadataClient, fillMetadata )
 import Cardano.Wallet.Transaction
@@ -1768,7 +1769,6 @@ selectCoins
         , s ~ SeqState n k
         , AddressBookIso s
         , GenChange s
-        , TxWitnessTagFor k
         )
     => ApiLayer s
     -> ArgGenChange s
@@ -1785,8 +1785,10 @@ selectCoins ctx@ApiLayer {..} argGenChange (ApiT walletId) body = do
         withdrawal <-
             body ^. #withdrawal
                 & maybe (pure NoWithdrawal)
-                    (shelleyOnlyMkWithdrawal @s
-                        netLayer (txWitnessTagFor @k) db)
+                    (shelleyOnlyMkWithdrawal
+                        netLayer
+                        (txWitnessTagForKey $ keyOfWallet $ walletFlavor @s)
+                        db)
         let genChange = W.defaultChangeAddressGen argGenChange
         let paymentOuts = NE.toList $ addressAmountToTxOut <$> body ^. #payments
         let txCtx = defaultTransactionCtx
@@ -1892,7 +1894,6 @@ selectCoinsForQuit
         , AddressBookIso s
         , Seq.SupportsDiscovery n k
         , DelegationAddress k 'CredFromKeyK
-        , TxWitnessTagFor k
         )
     => ApiLayer (SeqState n k)
     -> ApiT WalletId
@@ -1902,8 +1903,10 @@ selectCoinsForQuit ctx@ApiLayer{..} (ApiT walletId) = do
         <- liftIO $ W.readNodeTipStateForTxWrite netLayer
     withWorkerCtx ctx walletId liftE liftE $ \workerCtx -> liftIO $ do
         let db = workerCtx ^. typed @(DBLayer IO s)
-        withdrawal <- W.shelleyOnlyMkSelfWithdrawal @s
-            netLayer (txWitnessTagFor @k) db
+        withdrawal <- W.shelleyOnlyMkSelfWithdrawal
+            netLayer
+            (txWitnessTagForKey $ keyOfWallet $ walletFlavor @s)
+            db
         currentEpochSlotting <- liftIO $ getCurrentEpochSlotting netLayer
         action <- WD.quitStakePoolDelegationAction
             db currentEpochSlotting withdrawal
@@ -2154,7 +2157,6 @@ postTransactionOld
         , HardDerivation k
         , HasNetworkLayer IO ctx
         , Bounded (Index (AddressIndexDerivationType k) (AddressCredential k))
-        , TxWitnessTagFor k
         , AddressBookIso s
         , HasDelegation s
         , IsOurs s Address
@@ -2181,8 +2183,11 @@ postTransactionOld ctx@ApiLayer{..} argGenChange (ApiT wid) body = do
         wdrl <- case body ^. #withdrawal of
             Nothing -> pure NoWithdrawal
             Just apiWdrl ->
-                shelleyOnlyMkWithdrawal @s
-                    netLayer (txWitnessTagFor @k) db apiWdrl
+                shelleyOnlyMkWithdrawal
+                    netLayer
+                    (txWitnessTagForKey $ keyOfWallet $ walletFlavor @s)
+                    db
+                    apiWdrl
         let txCtx = defaultTransactionCtx
                 { txWithdrawal = wdrl
                 , txMetadata = md
@@ -2340,7 +2345,6 @@ postTransactionFeeOld
      . ( WalletFlavor s
        , Excluding '[SharedKey] k
        , AddressBookIso s
-       , TxWitnessTagFor k
        , k ~ KeyOf s
        , CredFromOf s ~ 'CredFromKeyK
        )
@@ -2363,8 +2367,11 @@ postTransactionFeeOld ctx@ApiLayer{..} (ApiT walletId) body = do
         wdrl <- case body ^. #withdrawal of
             Nothing -> pure NoWithdrawal
             Just apiWdrl ->
-                shelleyOnlyMkWithdrawal @s
-                    netLayer (txWitnessTagFor @k) db apiWdrl
+                shelleyOnlyMkWithdrawal
+                    netLayer
+                    (txWitnessTagForKey $ keyOfWallet $ walletFlavor @s)
+                    db
+                    apiWdrl
         let outputs = F.toList $ addressAmountToTxOut <$> body ^. #payments
             minCoins = W.calcMinimumCoinValues walletPP txLayer
                 <$> outputs
@@ -2415,8 +2422,8 @@ postTransactionFeeOld ctx@ApiLayer{..} (ApiT walletId) body = do
     padding = Quantity 20
 
 constructTransaction
-    :: forall s k n
-     . (HasSNetworkId n, s ~ SeqState n ShelleyKey, k ~ KeyOf s)
+    :: forall s n
+     . (HasSNetworkId n, s ~ SeqState n ShelleyKey)
     => ApiLayer s
     -> ArgGenChange s
     -> IO (Set PoolId)
@@ -2462,7 +2469,9 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d
         withdrawal <- case body ^. #withdrawal of
             Just SelfWithdraw -> liftIO $
                 W.shelleyOnlyMkSelfWithdrawal
-                    netLayer (txWitnessTagFor @k) db
+                    netLayer
+                    (txWitnessTagForKey $ keyOfWallet $ walletFlavor @s)
+                    db
             _ -> pure NoWithdrawal
 
         let transactionCtx0 = defaultTransactionCtx
@@ -2885,7 +2894,10 @@ constructSharedTransaction
         withdrawal <- case body ^. #withdrawal of
             Just SelfWithdraw -> liftIO $
                 W.mkSelfWithdrawalShared @n
-                    netLayer (txWitnessTagFor @SharedKey) delegationTemplateM db
+                    netLayer
+                    (txWitnessTagForKey SharedKeyS)
+                    delegationTemplateM
+                    db
             _ -> pure NoWithdrawal
 
         when (isNothing delegationTemplateM && isJust delegationRequest) $
@@ -3735,7 +3747,6 @@ listStakeKeys lookupStakeRef ctx@ApiLayer{..} (ApiT wid) =
 createMigrationPlan
     :: forall s n k
      . ( WalletFlavor s
-       , TxWitnessTagFor k
        , k ~ KeyOf s
        , CredFromOf s ~ 'CredFromKeyK
        , IsOurs s Address
@@ -3753,8 +3764,12 @@ createMigrationPlan ctx@ApiLayer{..} withdrawalType (ApiT wid) postData =
         let db = wrk ^. dbLayer
         rewardWithdrawal <- case withdrawalType of
             Nothing -> pure NoWithdrawal
-            Just pd -> shelleyOnlyMkWithdrawal @s
-                netLayer (txWitnessTagFor @k) db pd
+            Just pd ->
+                shelleyOnlyMkWithdrawal
+                    netLayer
+                    (txWitnessTagForKey $ keyOfWallet $ walletFlavor @s)
+                    db
+                    pd
         (wallet, _, _) <- handler $ W.readWallet wrk
         plan <- handler $ W.createMigrationPlan @_ wrk rewardWithdrawal
         liftHandler
@@ -3829,7 +3844,6 @@ migrateWallet
     :: forall s p k n.
         ( Bounded (Index (AddressIndexDerivationType k) (AddressCredential k))
         , HardDerivation k
-        , TxWitnessTagFor k
         , WalletFlavor s
         , HasDelegation s
         , k ~ KeyOf s
@@ -3856,8 +3870,12 @@ migrateWallet ctx@ApiLayer{..} withdrawalType (ApiT wid) postData = do
         era <- liftIO $ NW.currentNodeEra netLayer
         rewardWithdrawal <- case withdrawalType of
             Nothing -> pure NoWithdrawal
-            Just pd -> shelleyOnlyMkWithdrawal @s
-                netLayer (txWitnessTagFor @k) db pd
+            Just pd ->
+                shelleyOnlyMkWithdrawal
+                    netLayer
+                    (txWitnessTagForKey $ keyOfWallet $ walletFlavor @s)
+                    db
+                    pd
         plan <- handler $ W.createMigrationPlan @_ wrk rewardWithdrawal
         ttl <- liftIO $ W.transactionExpirySlot ti Nothing
         pp <- liftIO $ NW.currentProtocolParameters netLayer

lib/wallet/bench/api-bench.hs

@@ -95,7 +95,7 @@ import Cardano.Wallet.Read.NetworkId
     , withSNetworkId
     )
 import Cardano.Wallet.Shelley.Transaction
-    ( TxWitnessTagFor (..), newTransactionLayer )
+    ( newTransactionLayer )
 import Cardano.Wallet.Unsafe
     ( unsafeRunExceptT )
 import Control.Monad
@@ -437,7 +437,6 @@ data BenchmarkConfig (n :: NetworkDiscriminant) s =
 benchmarkWallets
     :: forall n s results
      . ( PersistAddressBook s
-       , TxWitnessTagFor (KeyOf s)
        , KeyFlavor (KeyOf s)
        , Buildable results
        , ToJSON results
@@ -489,7 +488,6 @@ withWalletsFromDirectory
      . ( PersistAddressBook s
        , WalletFlavor s
        , k ~ KeyOf s
-       , TxWitnessTagFor k
        , KeyFlavor k
        )
     => FilePath

lib/wallet/bench/restore-bench.hs

@@ -159,7 +159,7 @@ import Cardano.Wallet.Shelley.Compatibility
 import Cardano.Wallet.Shelley.Network.Node
     ( withNetworkLayer )
 import Cardano.Wallet.Shelley.Transaction
-    ( TxWitnessTagFor (..), newTransactionLayer )
+    ( newTransactionLayer )
 import Cardano.Wallet.Transaction
     ( PreSelection (..), defaultTransactionCtx )
 import Cardano.Wallet.Unsafe
@@ -184,8 +184,6 @@ import Data.Aeson
     ( ToJSON (..), genericToJSON, (.=) )
 import Data.Functor.Contravariant
     ( contramap )
-import Data.Kind
-    ( Type )
 import Data.List
     ( foldl' )
 import Data.Proxy
@@ -683,14 +681,12 @@ bench_baseline_restoration
 
 {- HLINT ignore bench_restoration "Use camelCase" -}
 bench_restoration
-    :: forall n (k :: Depth -> Type -> Type) s results.
+    :: forall n s results.
         ( IsOurs s RewardAccount
         , MaybeLight s
         , PersistAddressBook s
         , WalletFlavor s
-        , KeyOf s ~ k
         , HasSNetworkId n
-        , TxWitnessTagFor k
         , Buildable results
         , ToJSON results
         , IsOurs s Address

lib/wallet/src/Cardano/Wallet.hs

@@ -220,6 +220,7 @@ module Cardano.Wallet
     , throttle
     , guardHardIndex
     , utxoAssumptionsForWallet
+    , txWitnessTagForKey
 
     -- * Logging
     , WalletWorkerLog (..)
@@ -497,6 +498,8 @@ import Cardano.Wallet.Shelley.Compatibility
     )
 import Cardano.Wallet.Shelley.Compatibility.Ledger
     ( toWallet )
+import Cardano.Wallet.Shelley.Transaction
+    ( txWitnessTagForKey )
 import Cardano.Wallet.Transaction
     ( DelegationAction (..)
     , ErrCannotJoin (..)
@@ -515,7 +518,7 @@ import Cardano.Wallet.Transaction
 import Cardano.Wallet.Transaction.Built
     ( BuiltTx (..) )
 import Cardano.Wallet.TxWitnessTag
-    ( TxWitnessTag )
+    ( TxWitnessTag (..) )
 import Cardano.Wallet.Write.Tx
     ( recentEra )
 import Cardano.Wallet.Write.Tx.Balance

lib/wallet/src/Cardano/Wallet/Address/Derivation/Byron.hs

@@ -74,8 +74,6 @@ import Cardano.Wallet.Primitive.Types.ProtocolMagic
     ( magicSNetworkId )
 import Cardano.Wallet.Read.NetworkId
     ( SNetworkId (..) )
-import Cardano.Wallet.TxWitnessTag
-    ( TxWitnessTag (..), TxWitnessTagFor (..) )
 import Control.DeepSeq
     ( NFData )
 import Control.Lens
@@ -123,10 +121,6 @@ byronKey = lens getKey (\x k -> x { getKey = k })
 instance (NFData key, NFData (DerivationPathFrom depth)) => NFData (ByronKey depth key)
 deriving instance (Show key, Show (DerivationPathFrom depth)) => Show (ByronKey depth key)
 deriving instance (Eq key, Eq (DerivationPathFrom depth)) => Eq (ByronKey depth key)
-
-instance TxWitnessTagFor ByronKey where
-    txWitnessTagFor = TxWitnessByronUTxO
-
 -- | The hierarchical derivation indices for a given level/depth.
 type family DerivationPathFrom (depth :: Depth) :: Type where
     -- The root key is generated from the seed.

lib/wallet/src/Cardano/Wallet/Address/Derivation/Icarus.hs

@@ -77,8 +77,6 @@ import Cardano.Wallet.Read.NetworkId
     , NetworkDiscriminantCheck (..)
     , SNetworkId (..)
     )
-import Cardano.Wallet.TxWitnessTag
-    ( TxWitnessTag (..), TxWitnessTagFor (..) )
 import Control.Arrow
     ( first, left )
 import Control.DeepSeq
@@ -137,9 +135,6 @@ icarusKey = iso getKey IcarusKey
 
 instance NFData key => NFData (IcarusKey depth key)
 
-instance TxWitnessTagFor IcarusKey where
-    txWitnessTagFor = TxWitnessByronUTxO
-
 -- | The minimum seed length for 'generateKeyFromSeed' and 'unsafeGenerateKeyFromSeed'.
 minSeedLengthBytes :: Int
 minSeedLengthBytes = 16

lib/wallet/src/Cardano/Wallet/Address/Derivation/SharedKey.hs

@@ -43,8 +43,6 @@ import Cardano.Wallet.Primitive.Types.Address
     ( Address (..) )
 import Cardano.Wallet.Read.NetworkId
     ( HasSNetworkId (sNetworkId), SNetworkId (..) )
-import Cardano.Wallet.TxWitnessTag
-    ( TxWitnessTag (..), TxWitnessTagFor (..) )
 import Control.DeepSeq
     ( NFData (..) )
 import Control.Lens
@@ -90,9 +88,6 @@ sharedKey = iso getKey SharedKey
 
 instance NFData key => NFData (SharedKey depth key)
 
-instance TxWitnessTagFor SharedKey where
-    txWitnessTagFor = TxWitnessShelleyUTxO
-
 constructAddressFromIx
     :: forall n
      . HasSNetworkId n

lib/wallet/src/Cardano/Wallet/Address/Derivation/Shelley.hs

@@ -99,8 +99,6 @@ import Cardano.Wallet.Read.NetworkId
     , SNetworkId (..)
     , networkDiscriminantBits
     )
-import Cardano.Wallet.TxWitnessTag
-    ( TxWitnessTag (..), TxWitnessTagFor (..) )
 import Control.DeepSeq
     ( NFData (..) )
 import Control.Lens
@@ -150,9 +148,6 @@ shelleyKey = iso getKey ShelleyKey
 
 instance NFData key => NFData (ShelleyKey depth key)
 
-instance TxWitnessTagFor ShelleyKey where
-    txWitnessTagFor = TxWitnessShelleyUTxO
-
 -- | The minimum seed length for 'generateKeyFromSeed' and
 -- 'unsafeGenerateKeyFromSeed'.
 minSeedLengthBytes :: Int