Reduce dependency on Shelley.Compatibility module (#4058)

- [x] Move `estimate{Min, Max}WitnessRequiredPerInput` from
`AddressDerivation.Shared` to `Write.Tx.Sign` module
- [x] Remove `Write.Tx.Balance` dependency on
`Shelley.Compatibility.fromCardanoTx{In, Out}`

### Motivation

The new `cardano-balance-tx` library cannot depend on
`AddressDerivation.Shared`, and it's easier if we avoid depending on
`Shelley.Compatibility`. NB: We will need to bring the
`Shelley.Compatibility.Ledger` along (either to `cardano-balance-tx` or
to `primitive`).

### Issue Number

ADP-3081

lib/wallet/address/Cardano/Wallet/Address/Discovery/Shared.hs

@@ -40,8 +40,6 @@ module Cardano.Wallet.Address.Discovery.Shared
     , ErrScriptTemplate (..)
     , isShared
     , retrieveAllCosigners
-    , estimateMinWitnessRequiredPerInput
-    , estimateMaxWitnessRequiredPerInput
 
     , CredentialType (..)
     , liftPaymentAddress
@@ -131,8 +129,6 @@ import Fmt
     ( Buildable (..), blockListF', indentF )
 import GHC.Generics
     ( Generic )
-import Numeric.Natural
-    ( Natural )
 import Type.Reflection
     ( Typeable )
 
@@ -586,57 +582,6 @@ isOwned st (rootPrv, pwd) addr = case isShared addr st of
                 )
     (Nothing, _) -> Nothing
 
-estimateMinWitnessRequiredPerInput :: Script k -> Natural
-estimateMinWitnessRequiredPerInput = \case
-    RequireSignatureOf _ -> 1
-    RequireAllOf xs      ->
-        sum $ map estimateMinWitnessRequiredPerInput xs
-    RequireAnyOf xs      ->
-        optimumIfNotEmpty minimum $ map estimateMinWitnessRequiredPerInput xs
-    RequireSomeOf m xs   ->
-        let smallestReqFirst =
-                L.sort $ map estimateMinWitnessRequiredPerInput xs
-        in sum $ take (fromIntegral m) smallestReqFirst
-    ActiveFromSlot _     -> 0
-    ActiveUntilSlot _    -> 0
-
-optimumIfNotEmpty :: (Foldable t, Num p) => (t a -> p) -> t a -> p
-optimumIfNotEmpty f xs =
-    if null xs then
-        0
-    else f xs
-
-estimateMaxWitnessRequiredPerInput :: Script k -> Natural
-estimateMaxWitnessRequiredPerInput = \case
-    RequireSignatureOf _ -> 1
-    RequireAllOf xs      ->
-        sum $ map estimateMaxWitnessRequiredPerInput xs
-    RequireAnyOf xs      ->
-        sum $ map estimateMaxWitnessRequiredPerInput xs
-    -- Estimate (and tx fees) could be lowered with:
-    --
-    -- optimumIfNotEmpty maximum $ map estimateMaxWitnessRequiredPerInput xs
-    -- however signTransaction
-    --
-    -- however we'd then need to adjust signTx accordingly such that it still
-    -- doesn't add more witnesses than we plan for.
-    --
-    -- Partially related task: https://cardanofoundation.atlassian.net/browse/ADP-2676
-    RequireSomeOf _m xs   ->
-        sum $ map estimateMaxWitnessRequiredPerInput xs
-    -- Estimate (and tx fees) could be lowered with:
-    --
-    -- let largestReqFirst =
-    --      reverse $ L.sort $ map estimateMaxWitnessRequiredPerInput xs
-    -- in sum $ take (fromIntegral m) largestReqFirst
-    --
-    -- however we'd then need to adjust signTx accordingly such that it still
-    -- doesn't add more witnesses than we plan for.
-    --
-    -- Partially related task: https://cardanofoundation.atlassian.net/browse/ADP-2676
-    ActiveFromSlot _     -> 0
-    ActiveUntilSlot _    -> 0
-
 instance AccountIxForStaking (SharedState n SharedKey) where
     getAccountIx st =
         let DerivationPrefix (_, _, ix) = derivationPrefix st

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

@@ -704,6 +704,7 @@ import qualified Cardano.Wallet.Registry as Registry
 import qualified Cardano.Wallet.Write.ProtocolParameters as Write
 import qualified Cardano.Wallet.Write.Tx as Write
 import qualified Cardano.Wallet.Write.Tx.Balance as Write
+import qualified Cardano.Wallet.Write.Tx.Sign as Write
 import qualified Control.Concurrent.Concierge as Concierge
 import qualified Data.ByteString as BS
 import qualified Data.Foldable as F
@@ -3468,12 +3469,12 @@ submitSharedTransaction ctx apiw@(ApiT wid) apitx = do
                     if numberStakingNativeScripts == 0 then
                         0
                     else if numberStakingNativeScripts == 1 then
-                        Shared.estimateMinWitnessRequiredPerInput scriptD
+                        Write.estimateMinWitnessRequiredPerInput scriptD
                     else
                         error "wallet supports transactions with 0 or 1 staking script"
 
         let (ScriptTemplate _ scriptP) = Shared.paymentTemplate $ getState cp
-        let pWitsPerInput = Shared.estimateMinWitnessRequiredPerInput scriptP
+        let pWitsPerInput = Write.estimateMinWitnessRequiredPerInput scriptP
         let witsRequiredForInputs =
                 length $ L.nubBy samePaymentKey $
                 filter isInpOurs $

lib/wallet/cardano-wallet.cabal

@@ -729,6 +729,7 @@ test-suite unit
     , cardano-crypto-wrapper
     , cardano-ledger-alonzo
     , cardano-ledger-alonzo-test
+    , cardano-ledger-allegra:{cardano-ledger-allegra, testlib}
     , cardano-ledger-api
     , cardano-ledger-babbage:{cardano-ledger-babbage, testlib}
     , cardano-ledger-byron

lib/wallet/src/Cardano/Wallet/Shelley/Compatibility/Ledger.hs

@@ -20,6 +20,7 @@ module Cardano.Wallet.Shelley.Compatibility.Ledger
     , toLedgerTokenPolicyId
     , toLedgerTokenName
     , toLedgerTokenQuantity
+    , toLedgerTimelockScript
 
       -- * Conversions from ledger specification types to wallet types
     , toWalletCoin
@@ -114,6 +115,7 @@ import qualified Cardano.Wallet.Primitive.Types.Coin as Coin
 import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
 import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap
 import qualified Data.Map.Strict as Map
+import qualified Data.Sequence.Strict as StrictSeq
 import qualified Ouroboros.Network.Block as O
 
 --------------------------------------------------------------------------------
@@ -396,3 +398,40 @@ toWalletScriptFromShelley keyrole = fromLedgerScript'
         RequireAnyOf $ map fromLedgerScript' $ toList contents
     fromLedgerScript' (Ledger.RequireMOf num contents) =
         RequireSomeOf (fromIntegral num) $ fromLedgerScript' <$> toList contents
+
+toLedgerTimelockScript
+    :: LCore.Era era
+    => Script KeyHash
+    -> Scripts.Timelock era
+toLedgerTimelockScript s = case s of
+    RequireSignatureOf (KeyHash _ keyhash) ->
+        case hashFromBytes keyhash of
+            Just h -> Scripts.RequireSignature (Ledger.KeyHash h)
+            Nothing -> error "Hash key not valid"
+    RequireAllOf contents ->
+        Scripts.RequireAllOf
+        $ StrictSeq.fromList
+        $ map toLedgerTimelockScript contents
+    RequireAnyOf contents ->
+        Scripts.RequireAnyOf
+        $ StrictSeq.fromList
+        $ map toLedgerTimelockScript contents
+    RequireSomeOf num contents ->
+        Scripts.RequireMOf (intCast num)
+        $ StrictSeq.fromList
+        $ map toLedgerTimelockScript contents
+    ActiveUntilSlot slot ->
+        Scripts.RequireTimeExpire
+        (convertSlotNo slot)
+    ActiveFromSlot slot ->
+        Scripts.RequireTimeStart
+        (convertSlotNo slot)
+  where
+    convertSlotNo :: Natural -> O.SlotNo
+    convertSlotNo x = O.SlotNo $ fromMaybe err $ intCastMaybe x
+      where
+        err = error $ unwords
+            [ "toLedgerTimelockScript:"
+            , "Unexpected out of bounds SlotNo"
+            , show x
+            ]