From 9aaa4bd6dc3bdabc85dab633bff181b3b826ea42 Mon Sep 17 00:00:00 2001 From: paolino Date: Thu, 23 Nov 2023 08:39:33 +0000 Subject: [PATCH 1/3] Migrate conversions lib to primitive --- .../cardano-wallet-conversions.cabal | 32 +- lib/primitive/cardano-wallet-primitive.cabal | 48 +- .../Wallet/Shelley/Compatibility/Ledger.hs | 472 ++++++++++++++++++ .../Shelley/Compatibility/LedgerSpec.hs | 194 +++++++ 4 files changed, 715 insertions(+), 31 deletions(-) create mode 100644 lib/primitive/lib/Cardano/Wallet/Shelley/Compatibility/Ledger.hs create mode 100644 lib/primitive/test/spec/Cardano/Wallet/Shelley/Compatibility/LedgerSpec.hs diff --git a/lib/conversions/cardano-wallet-conversions.cabal b/lib/conversions/cardano-wallet-conversions.cabal index cb583d6255e..6ecfbe894b2 100644 --- a/lib/conversions/cardano-wallet-conversions.cabal +++ b/lib/conversions/cardano-wallet-conversions.cabal @@ -1,15 +1,15 @@ -cabal-version: 3.0 -name: cardano-wallet-conversions -version: 2023.7.18 -synopsis: Miscellaneous conversion functions. -description: Please see README.md. -homepage: https://github.com/cardano-foundation/cardano-wallet -author: Cardano Foundation (High Assurance Lab) -maintainer: hal@cardanofoundation.org -copyright: 2018-2022 IOHK, 2023 Cardano Foundation -license: Apache-2.0 -category: Blockchain, Cardano -build-type: Simple +cabal-version: 3.0 +name: cardano-wallet-conversions +version: 2023.7.18 +synopsis: Miscellaneous conversion functions. +description: Please see README.md. +homepage: https://github.com/cardano-foundation/cardano-wallet +author: Cardano Foundation (High Assurance Lab) +maintainer: hal@cardanofoundation.org +copyright: 2018-2022 IOHK, 2023 Cardano Foundation +license: Apache-2.0 +category: Blockchain, Cardano +build-type: Simple common language default-language: Haskell2010 @@ -57,8 +57,10 @@ library , generic-lens , int-cast , ouroboros-consensus-cardano + exposed-modules: - Cardano.Wallet.Shelley.Compatibility.Ledger + +-- Cardano.Wallet.Shelley.Compatibility.Ledger test-suite test import: language, opts-exe @@ -79,8 +81,10 @@ test-suite test , ouroboros-consensus-cardano , QuickCheck , with-utf8 + build-tool-depends: hspec-discover:hspec-discover other-modules: - Cardano.Wallet.Shelley.Compatibility.LedgerSpec Spec SpecHook + +-- Cardano.Wallet.Shelley.Compatibility.LedgerSpec diff --git a/lib/primitive/cardano-wallet-primitive.cabal b/lib/primitive/cardano-wallet-primitive.cabal index e83ca3b78e7..cca54102c6d 100644 --- a/lib/primitive/cardano-wallet-primitive.cabal +++ b/lib/primitive/cardano-wallet-primitive.cabal @@ -1,15 +1,15 @@ -cabal-version: 3.0 -name: cardano-wallet-primitive -version: 2023.7.18 -synopsis: Selected primitive types for Cardano Wallet. -description: Please see README.md. -homepage: https://github.com/cardano-foundation/cardano-wallet -author: Cardano Foundation (High Assurance Lab) -maintainer: hal@cardanofoundation.org -copyright: 2018-2022 IOHK, 2023 Cardano Foundation -license: Apache-2.0 -category: Web -build-type: Simple +cabal-version: 3.0 +name: cardano-wallet-primitive +version: 2023.7.18 +synopsis: Selected primitive types for Cardano Wallet. +description: Please see README.md. +homepage: https://github.com/cardano-foundation/cardano-wallet +author: Cardano Foundation (High Assurance Lab) +maintainer: hal@cardanofoundation.org +copyright: 2018-2022 IOHK, 2023 Cardano Foundation +license: Apache-2.0 +category: Web +build-type: Simple common language default-language: Haskell2010 @@ -37,7 +37,6 @@ flag release library import: language, opts-lib hs-source-dirs: lib - build-depends: , aeson , base @@ -46,20 +45,28 @@ library , binary , bytestring , cardano-addresses - , cardano-binary , cardano-api + , cardano-binary , cardano-crypto + , cardano-crypto-class + , cardano-ledger-allegra + , cardano-ledger-alonzo + , cardano-ledger-babbage + , cardano-ledger-core + , cardano-ledger-mary + , cardano-ledger-shelley , cardano-numeric , cardano-slotting + , cardano-strict-containers , cardano-wallet-read , cardano-wallet-test-utils , cborg , commutative-semigroups - , contra-tracer , containers + , contra-tracer , cryptonite - , delta-types , deepseq + , delta-types , errors , extra , fmt @@ -79,6 +86,7 @@ library , nothunks , OddWord , ouroboros-consensus + , ouroboros-consensus-cardano , pretty-simple , QuickCheck , quiet @@ -147,6 +155,7 @@ library Cardano.Wallet.Primitive.Types.TxParameters Cardano.Wallet.Primitive.Types.UTxO Cardano.Wallet.Primitive.Types.UTxO.Gen + Cardano.Wallet.Shelley.Compatibility.Ledger Cardano.Wallet.Unsafe Cardano.Wallet.Util Control.Monad.Random.NonRandom @@ -166,6 +175,8 @@ test-suite test , base58-bytestring , binary , bytestring + , cardano-addresses + , cardano-ledger-allegra:{cardano-ledger-allegra, testlib} , cardano-ledger-byron-test , cardano-ledger-core:{cardano-ledger-core, testlib} , cardano-ledger-shelley-test @@ -174,9 +185,9 @@ test-suite test , cardano-wallet-primitive , cardano-wallet-test-utils , containers + , deepseq , delta-store , delta-types - , deepseq , filepath , fmt , generic-arbitrary @@ -188,6 +199,7 @@ test-suite test , lattices , MonadRandom , ouroboros-consensus + , ouroboros-consensus-cardano , QuickCheck , quickcheck-classes , quickcheck-instances @@ -201,6 +213,7 @@ test-suite test , transformers , unliftio , with-utf8 + build-tool-depends: hspec-discover:hspec-discover other-modules: Cardano.Wallet.Primitive.CollateralSpec @@ -218,6 +231,7 @@ test-suite test Cardano.Wallet.Primitive.Types.TokenQuantitySpec Cardano.Wallet.Primitive.Types.TxSpec Cardano.Wallet.Primitive.Types.UTxOSpec + Cardano.Wallet.Shelley.Compatibility.LedgerSpec Data.QuantitySpec Spec SpecHook diff --git a/lib/primitive/lib/Cardano/Wallet/Shelley/Compatibility/Ledger.hs b/lib/primitive/lib/Cardano/Wallet/Shelley/Compatibility/Ledger.hs new file mode 100644 index 00000000000..a21edb8e893 --- /dev/null +++ b/lib/primitive/lib/Cardano/Wallet/Shelley/Compatibility/Ledger.hs @@ -0,0 +1,472 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE TypeApplications #-} + +-- | +-- Copyright: © 2020 IOHK +-- License: Apache-2.0 +-- +-- Exposes a wallet-friendly interface to types and functions exported by the +-- ledger specification. +-- +module Cardano.Wallet.Shelley.Compatibility.Ledger + ( + -- * Conversions from wallet types to ledger specification types + toLedgerAddress + , toLedgerCoin + , toLedgerTokenBundle + , toLedgerTokenPolicyId + , toLedgerTokenName + , toLedgerTokenQuantity + , toLedgerTimelockScript + + -- * Conversions from ledger specification types to wallet types + , toWalletAddress + , toWalletCoin + , toWalletTokenBundle + , toWalletTokenPolicyId + , toWalletTokenName + , toWalletTokenQuantity + , toWalletScript + , toWalletScriptFromShelley + + -- * Roundtrip conversion between wallet types and ledger specification + -- types + , Convert (..) + + -- * Conversions for transaction outputs + , toShelleyTxOut + , toAllegraTxOut + , toMaryTxOut + , toAlonzoTxOut + , toBabbageTxOut + , toConwayTxOut + , fromBabbageTxOut + , fromConwayTxOut + ) where + +import Prelude + +import Cardano.Address.Script + ( KeyHash (..) + , KeyRole (..) + , Script (..) + ) +import Cardano.Crypto.Hash + ( hashFromBytes + , hashToBytes + ) +import Cardano.Slotting.Slot + ( SlotNo (..) + ) +import Cardano.Wallet.Primitive.Types.Address + ( Address (..) + ) +import Cardano.Wallet.Primitive.Types.Coin + ( Coin (..) + ) +import Cardano.Wallet.Primitive.Types.Hash + ( Hash (..) + ) +import Cardano.Wallet.Primitive.Types.TokenBundle + ( TokenBundle (..) + ) +import Cardano.Wallet.Primitive.Types.TokenPolicy + ( TokenName (..) + , TokenPolicyId (..) + ) +import Cardano.Wallet.Primitive.Types.TokenQuantity + ( TokenQuantity (..) + ) +import Cardano.Wallet.Primitive.Types.Tx.TxIn + ( TxIn (..) + ) +import Cardano.Wallet.Primitive.Types.Tx.TxOut + ( TxOut (..) + ) +import Data.ByteString.Short + ( fromShort + , toShort + ) +import Data.Foldable + ( toList + ) +import Data.Function + ( (&) + ) +import Data.Generics.Internal.VL.Lens + ( view + ) +import Data.Generics.Labels + () +import Data.IntCast + ( intCast + , intCastMaybe + ) +import Data.Maybe + ( fromMaybe + ) +import Fmt + ( pretty + ) +import GHC.Stack + ( HasCallStack + ) +import Numeric.Natural + ( Natural + ) +import Ouroboros.Consensus.Shelley.Eras + ( StandardAllegra + , StandardAlonzo + , StandardBabbage + , StandardConway + , StandardCrypto + , StandardMary + , StandardShelley + ) + +import qualified Cardano.Crypto.Hash.Class as Crypto +import qualified Cardano.Ledger.Address as Ledger +import qualified Cardano.Ledger.Allegra.Scripts as Scripts +import qualified Cardano.Ledger.Alonzo as Alonzo +import qualified Cardano.Ledger.Alonzo.TxBody as Alonzo +import qualified Cardano.Ledger.Babbage as Babbage +import qualified Cardano.Ledger.Babbage.TxBody as Babbage +import qualified Cardano.Ledger.Core as LCore +import qualified Cardano.Ledger.Keys as Ledger +import qualified Cardano.Ledger.Mary.Value as Ledger +import qualified Cardano.Ledger.SafeHash as SafeHash +import qualified Cardano.Ledger.Shelley.API as Ledger +import qualified Cardano.Ledger.Shelley.TxBody as Shelley +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 + +-------------------------------------------------------------------------------- +-- Roundtrip conversion between wallet types and ledger specification types +-------------------------------------------------------------------------------- + +-- | Connects a wallet type with its equivalent ledger specification type. +-- +-- Instances of this class should satisfy the following laws: +-- +-- >>> toLedger . toWallet == id +-- >>> toWallet . toLedger == id +-- +class Convert wallet ledger | wallet -> ledger where + -- | Converts a value from a wallet type to the equivalent ledger + -- specification type. + toLedger + :: HasCallStack => wallet -> ledger + -- | Converts a value from a ledger specification type to the equivalent + -- wallet type. + toWallet + :: HasCallStack => ledger -> wallet + +-------------------------------------------------------------------------------- +-- Conversions for 'Coin' +-------------------------------------------------------------------------------- + +instance Convert Coin Ledger.Coin where + toLedger = toLedgerCoin + toWallet = toWalletCoin + +toLedgerCoin :: Coin -> Ledger.Coin +toLedgerCoin (Coin c) = Ledger.Coin $ intCast @Natural @Integer c + +toWalletCoin :: HasCallStack => Ledger.Coin -> Coin +toWalletCoin (Ledger.Coin c) = Coin.unsafeFromIntegral c + +-------------------------------------------------------------------------------- +-- Conversions for 'TokenBundle' +-------------------------------------------------------------------------------- + +-- Values of the ledger specification's 'Value' type are constructed in a way +-- that is similar to the wallet's 'TokenBundle' type. The ada quantity is +-- stored as a separate value, and asset quantities are stored in a nested map. + +instance Convert TokenBundle (Ledger.MaryValue StandardCrypto) where + toLedger = toLedgerTokenBundle + toWallet = toWalletTokenBundle + +toLedgerTokenBundle :: TokenBundle -> Ledger.MaryValue StandardCrypto +toLedgerTokenBundle bundle = + Ledger.MaryValue ledgerAda ledgerTokens + where + (Ledger.Coin ledgerAda) = toLedgerCoin $ TokenBundle.getCoin bundle + ledgerTokens :: Ledger.MultiAsset StandardCrypto + ledgerTokens = bundle + & view #tokens + & TokenMap.toNestedMap + & Map.mapKeys toLedgerTokenPolicyId + & Map.map mapInner + & Ledger.MultiAsset + mapInner inner = inner + & Map.mapKeys toLedgerTokenName + & Map.map toLedgerTokenQuantity + +toWalletTokenBundle :: Ledger.MaryValue StandardCrypto -> TokenBundle +toWalletTokenBundle + (Ledger.MaryValue ledgerAda (Ledger.MultiAsset ledgerTokens)) = + TokenBundle.fromNestedMap (walletAda, walletTokens) + where + walletAda = toWalletCoin $ Ledger.Coin ledgerAda + walletTokens = ledgerTokens + & Map.mapKeys toWalletTokenPolicyId + & Map.map mapInner + mapInner inner = inner + & Map.mapKeys toWalletTokenName + & Map.map toWalletTokenQuantity + +-------------------------------------------------------------------------------- +-- Conversions for 'TokenName' +-------------------------------------------------------------------------------- + +instance Convert TokenName Ledger.AssetName where + toLedger = toLedgerTokenName + toWallet = toWalletTokenName + +toLedgerTokenName :: TokenName -> Ledger.AssetName +toLedgerTokenName (UnsafeTokenName bytes) = + Ledger.AssetName $ toShort bytes + +toWalletTokenName :: Ledger.AssetName -> TokenName +toWalletTokenName (Ledger.AssetName bytes) = + UnsafeTokenName $ fromShort bytes + +-------------------------------------------------------------------------------- +-- Conversions for 'TokenPolicyId' +-------------------------------------------------------------------------------- + +instance Convert TokenPolicyId (Ledger.PolicyID StandardCrypto) where + toLedger = toLedgerTokenPolicyId + toWallet = toWalletTokenPolicyId + +toLedgerTokenPolicyId :: TokenPolicyId -> Ledger.PolicyID StandardCrypto +toLedgerTokenPolicyId p@(UnsafeTokenPolicyId (Hash bytes)) = + case hashFromBytes bytes of + Just hash -> + Ledger.PolicyID (Ledger.ScriptHash hash) + Nothing -> + error $ unwords + [ "Ledger.toLedgerTokenPolicyId" + , "Unable to construct hash for token policy:" + , pretty p + ] + +toWalletTokenPolicyId :: Ledger.PolicyID StandardCrypto -> TokenPolicyId +toWalletTokenPolicyId (Ledger.PolicyID (Ledger.ScriptHash hash)) = + UnsafeTokenPolicyId (Hash (hashToBytes hash)) + +-------------------------------------------------------------------------------- +-- Conversions for 'TokenQuantity' +-------------------------------------------------------------------------------- + +instance Convert TokenQuantity Integer where + toLedger = toLedgerTokenQuantity + toWallet = toWalletTokenQuantity + +toLedgerTokenQuantity :: TokenQuantity -> Integer +toLedgerTokenQuantity (TokenQuantity q) = fromIntegral q + +toWalletTokenQuantity :: Integer -> TokenQuantity +toWalletTokenQuantity q + | q >= 0 = + TokenQuantity $ fromIntegral q + | otherwise = + error $ unwords + [ "Ledger.toWalletTokenQuantity:" + , "Unexpected negative value:" + , pretty q + ] + +-------------------------------------------------------------------------------- +-- Conversions for 'TxIn' +-------------------------------------------------------------------------------- + +instance Convert TxIn (Ledger.TxIn StandardCrypto) where + toLedger (TxIn tid ix) = + Ledger.TxIn (toLedgerHash tid) (toEnum $ intCast ix) + where + toLedgerHash (Hash h) = + Ledger.TxId + $ SafeHash.unsafeMakeSafeHash + $ Crypto.UnsafeHash + $ toShort h + + toWallet (Ledger.TxIn (Ledger.TxId tid) ix) = + TxIn (convertId tid) (convertIx ix) + where + convertId = Hash . Crypto.hashToBytes . SafeHash.extractHash + + convertIx = fromMaybe err . intCastMaybe . fromEnum + where + err = error $ unwords + [ "Ledger.toWallet @TxIn:" + , "Unexpected out of bounds TxIx" + , show ix + ] + +-------------------------------------------------------------------------------- +-- Conversions for 'Address' +-------------------------------------------------------------------------------- + +instance Convert Address (Ledger.Addr StandardCrypto) where + toLedger = toLedgerAddress + toWallet = toWalletAddress + +toLedgerAddress :: Address -> Ledger.Addr StandardCrypto +toLedgerAddress (Address bytes) = case Ledger.deserialiseAddr bytes of + Just addr -> addr + Nothing -> error $ unwords + [ "toLedger @Address: Invalid address:" + , pretty (Address bytes) + ] + +toWalletAddress :: Ledger.Addr StandardCrypto -> Address +toWalletAddress = Address . Ledger.serialiseAddr + +-------------------------------------------------------------------------------- +-- Conversions for 'TxOut' +-------------------------------------------------------------------------------- + +toShelleyTxOut + :: TxOut + -> Shelley.ShelleyTxOut StandardShelley +toShelleyTxOut (TxOut addr bundle) = + Shelley.ShelleyTxOut (toLedger addr) (toLedger (TokenBundle.coin bundle)) + +toAllegraTxOut + :: TxOut + -> Shelley.ShelleyTxOut StandardAllegra +toAllegraTxOut (TxOut addr bundle) = + Shelley.ShelleyTxOut (toLedger addr) (toLedger (TokenBundle.coin bundle)) + +toMaryTxOut + :: TxOut + -> Shelley.ShelleyTxOut StandardMary +toMaryTxOut (TxOut addr bundle) = + Shelley.ShelleyTxOut (toLedger addr) (toLedger bundle) + +toAlonzoTxOut + :: TxOut + -> Alonzo.AlonzoTxOut StandardAlonzo +toAlonzoTxOut (TxOut addr bundle) = + Alonzo.AlonzoTxOut + (toLedger addr) + (toLedger bundle) + Ledger.SNothing + +toBabbageTxOut + :: HasCallStack + => TxOut + -> Babbage.BabbageTxOut StandardBabbage +toBabbageTxOut (TxOut addr bundle) = + Babbage.BabbageTxOut + (toLedger addr) + (toLedger bundle) + Babbage.NoDatum + Ledger.SNothing + +toConwayTxOut + :: TxOut + -> Babbage.BabbageTxOut StandardConway +toConwayTxOut (TxOut addr bundle) = + Babbage.BabbageTxOut + (toLedger addr) + (toLedger bundle) + Babbage.NoDatum + Ledger.SNothing + +-- NOTE: Inline scripts and datums will be lost in the conversion. +fromConwayTxOut + :: Babbage.BabbageTxOut StandardConway + -> TxOut +fromConwayTxOut (Babbage.BabbageTxOut addr val _ _) + = TxOut (toWallet addr) (toWallet val) + +-- NOTE: Inline scripts and datums will be lost in the conversion. +fromBabbageTxOut + :: Babbage.BabbageTxOut StandardBabbage + -> TxOut +fromBabbageTxOut (Babbage.BabbageTxOut addr val _ _) + = TxOut (toWallet addr) (toWallet val) + +toWalletScript + :: LCore.Era crypto + => (Hash "VerificationKey" -> KeyRole) + -> Scripts.Timelock crypto + -> Script KeyHash +toWalletScript tokeyrole = fromLedgerScript + where + fromLedgerScript (Scripts.RequireSignature (Ledger.KeyHash h)) = + let payload = hashToBytes h + in RequireSignatureOf (KeyHash (tokeyrole (Hash payload)) payload) + fromLedgerScript (Scripts.RequireAllOf contents) = + RequireAllOf $ map fromLedgerScript $ toList contents + fromLedgerScript (Scripts.RequireAnyOf contents) = + RequireAnyOf $ map fromLedgerScript $ toList contents + fromLedgerScript (Scripts.RequireMOf num contents) = + RequireSomeOf (fromIntegral num) $ fromLedgerScript <$> toList contents + fromLedgerScript (Scripts.RequireTimeExpire (SlotNo slot)) = + ActiveUntilSlot $ fromIntegral slot + fromLedgerScript (Scripts.RequireTimeStart (SlotNo slot)) = + ActiveFromSlot $ fromIntegral slot + +toWalletScriptFromShelley + :: LCore.Era crypto + => KeyRole + -> Ledger.MultiSig crypto + -> Script KeyHash +toWalletScriptFromShelley keyrole = fromLedgerScript' + where + fromLedgerScript' (Ledger.RequireSignature (Ledger.KeyHash h)) = + RequireSignatureOf (KeyHash keyrole (hashToBytes h)) + fromLedgerScript' (Ledger.RequireAllOf contents) = + RequireAllOf $ map fromLedgerScript' $ toList contents + fromLedgerScript' (Ledger.RequireAnyOf contents) = + 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 -> SlotNo + convertSlotNo x = SlotNo $ fromMaybe err $ intCastMaybe x + where + err = error $ unwords + [ "toLedgerTimelockScript:" + , "Unexpected out of bounds SlotNo" + , show x + ] diff --git a/lib/primitive/test/spec/Cardano/Wallet/Shelley/Compatibility/LedgerSpec.hs b/lib/primitive/test/spec/Cardano/Wallet/Shelley/Compatibility/LedgerSpec.hs new file mode 100644 index 00000000000..28c2fb4089d --- /dev/null +++ b/lib/primitive/test/spec/Cardano/Wallet/Shelley/Compatibility/LedgerSpec.hs @@ -0,0 +1,194 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Cardano.Wallet.Shelley.Compatibility.LedgerSpec + ( spec + ) where + +import Prelude + +import Cardano.Address.Script + ( KeyHash (..) + , KeyRole (..) + , Script (..) + ) +import Cardano.Wallet.Primitive.Types.Coin + ( Coin (..) + ) +import Cardano.Wallet.Primitive.Types.TokenBundle + ( TokenBundle + ) +import Cardano.Wallet.Primitive.Types.TokenBundle.Gen + ( genTokenBundleSmallRange + , shrinkTokenBundleSmallRange + ) +import Cardano.Wallet.Primitive.Types.TokenPolicy + ( TokenName + , TokenPolicyId + ) +import Cardano.Wallet.Primitive.Types.TokenPolicy.Gen + ( genTokenNameLargeRange + , genTokenPolicyIdLargeRange + ) +import Cardano.Wallet.Primitive.Types.TokenQuantity + ( TokenQuantity (..) + ) +import Cardano.Wallet.Primitive.Types.TokenQuantity.Gen + ( genTokenQuantityFullRange + , shrinkTokenQuantityFullRange + ) +import Cardano.Wallet.Primitive.Types.Tx.TxIn + ( TxIn (..) + ) +import Cardano.Wallet.Primitive.Types.Tx.TxIn.Gen + ( genTxIn + , shrinkTxIn + ) +import Cardano.Wallet.Primitive.Types.Tx.TxOut.Gen + ( genTxOutCoin + , shrinkTxOutCoin + ) +import Cardano.Wallet.Shelley.Compatibility.Ledger + ( Convert (..) + , toLedgerTimelockScript + , toWalletScript + ) +import Data.Proxy + ( Proxy (..) + ) +import Data.Typeable + ( Typeable + , typeRep + ) +import Ouroboros.Consensus.Shelley.Eras + ( StandardBabbage + ) +import Test.Cardano.Ledger.Allegra.Arbitrary + () +import Test.Hspec + ( Spec + , describe + , it + ) +import Test.Hspec.Core.QuickCheck + ( modifyMaxSuccess + ) +import Test.QuickCheck + ( Arbitrary (..) + , Gen + , Positive (Positive) + , arbitrarySizedNatural + , choose + , elements + , oneof + , property + , scale + , sized + , vectorOf + , (===) + ) + +import qualified Data.ByteString as BS + +spec :: Spec +spec = describe "Cardano.Wallet.Shelley.Compatibility.LedgerSpec" $ + + modifyMaxSuccess (const 1000) $ do + + describe "Roundtrip conversions" $ do + + ledgerRoundtrip $ Proxy @Coin + ledgerRoundtrip $ Proxy @TokenBundle + ledgerRoundtrip $ Proxy @TokenName + ledgerRoundtrip $ Proxy @TokenPolicyId + ledgerRoundtrip $ Proxy @TokenQuantity + ledgerRoundtrip $ Proxy @TxIn + + describe "Timelock roundtrips (toLedgerTimelockScript, toWalletScript)" $ do + let ledger = toLedgerTimelockScript @StandardBabbage + let wallet = toWalletScript (const Unknown) + + it "ledger . wallet . ledger == ledger" $ property $ \s -> do + -- Ignore key role by doing one extra conversion + ledger (wallet $ ledger s) === ledger s + + it "ledger . wallet == id" $ property $ \s -> do + ledger (wallet s) === s + +-------------------------------------------------------------------------------- +-- Utilities +-------------------------------------------------------------------------------- + +ledgerRoundtrip + :: forall w l. (Arbitrary w, Eq w, Show w, Typeable w, Convert w l) + => Proxy w + -> Spec +ledgerRoundtrip proxy = it title $ + property $ \a -> toWallet (toLedger @w a) === a + where + title = mconcat + [ "Can perform roundtrip conversion for values of type '" + , show (typeRep proxy) + , "'" + ] + +-------------------------------------------------------------------------------- +-- Arbitraries +-------------------------------------------------------------------------------- + +instance Arbitrary Coin where + -- This instance is used to test roundtrip conversions, so it's important + -- that we generate coins across the full range available. + arbitrary = genTxOutCoin + shrink = shrinkTxOutCoin + +instance Arbitrary TokenBundle where + arbitrary = genTokenBundleSmallRange + shrink = shrinkTokenBundleSmallRange + +instance Arbitrary TokenName where + arbitrary = genTokenNameLargeRange + -- No shrinking + +instance Arbitrary TokenPolicyId where + arbitrary = genTokenPolicyIdLargeRange + -- No shrinking + +instance Arbitrary TokenQuantity where + arbitrary = genTokenQuantityFullRange + shrink = shrinkTokenQuantityFullRange + +instance Arbitrary TxIn where + arbitrary = genTxIn + shrink = shrinkTxIn + +instance Arbitrary (Script KeyHash) where + arbitrary = do + keyHashes <- vectorOf 10 arbitrary + genScript keyHashes + where + genScript :: [a] -> Gen (Script a) + genScript elems = scale (`div` 3) $ sized scriptTree + where + scriptTree 0 = oneof + [ RequireSignatureOf <$> elements elems + , ActiveFromSlot <$> arbitrarySizedNatural + , ActiveUntilSlot <$> arbitrarySizedNatural + ] + scriptTree n = do + Positive m <- arbitrary + let n' = n `div` (m + 1) + scripts' <- vectorOf m (scriptTree n') + atLeast <- choose (1, fromIntegral m) + elements + [ RequireAllOf scripts' + , RequireAnyOf scripts' + , RequireSomeOf atLeast scripts' + ] + +instance Arbitrary KeyHash where + arbitrary = do + cred <- elements [Payment, Delegation, Policy, Unknown] + KeyHash cred . BS.pack <$> vectorOf 28 arbitrary From ca2b86cba373930f3b795cc899b390f221d87354 Mon Sep 17 00:00:00 2001 From: paolino Date: Thu, 23 Nov 2023 09:07:55 +0000 Subject: [PATCH 2/3] Remove conversions lib --- lib/balance-tx/cardano-balance-tx.cabal | 1 - .../cardano-wallet-conversions.cabal | 90 ---- .../Wallet/Shelley/Compatibility/Ledger.hs | 472 ------------------ .../Shelley/Compatibility/LedgerSpec.hs | 194 ------- lib/conversions/test/spec/Spec.hs | 1 - lib/conversions/test/spec/SpecHook.hs | 10 - lib/conversions/test/spec/run-test-suite.hs | 15 - lib/wallet/cardano-wallet.cabal | 7 +- 8 files changed, 2 insertions(+), 788 deletions(-) delete mode 100644 lib/conversions/cardano-wallet-conversions.cabal delete mode 100644 lib/conversions/lib/Cardano/Wallet/Shelley/Compatibility/Ledger.hs delete mode 100644 lib/conversions/test/spec/Cardano/Wallet/Shelley/Compatibility/LedgerSpec.hs delete mode 100644 lib/conversions/test/spec/Spec.hs delete mode 100644 lib/conversions/test/spec/SpecHook.hs delete mode 100644 lib/conversions/test/spec/run-test-suite.hs diff --git a/lib/balance-tx/cardano-balance-tx.cabal b/lib/balance-tx/cardano-balance-tx.cabal index bb453876498..a97ea5248de 100644 --- a/lib/balance-tx/cardano-balance-tx.cabal +++ b/lib/balance-tx/cardano-balance-tx.cabal @@ -64,7 +64,6 @@ library internal , cardano-ledger-shelley , cardano-slotting , cardano-strict-containers - , cardano-wallet-conversions , cardano-wallet-primitive , cardano-wallet-test-utils , cborg diff --git a/lib/conversions/cardano-wallet-conversions.cabal b/lib/conversions/cardano-wallet-conversions.cabal deleted file mode 100644 index 6ecfbe894b2..00000000000 --- a/lib/conversions/cardano-wallet-conversions.cabal +++ /dev/null @@ -1,90 +0,0 @@ -cabal-version: 3.0 -name: cardano-wallet-conversions -version: 2023.7.18 -synopsis: Miscellaneous conversion functions. -description: Please see README.md. -homepage: https://github.com/cardano-foundation/cardano-wallet -author: Cardano Foundation (High Assurance Lab) -maintainer: hal@cardanofoundation.org -copyright: 2018-2022 IOHK, 2023 Cardano Foundation -license: Apache-2.0 -category: Blockchain, Cardano -build-type: Simple - -common language - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -common opts-lib - ghc-options: -Wall -Wcompat -fwarn-redundant-constraints - - if flag(release) - ghc-options: -O2 -Werror - -common opts-exe - ghc-options: -threaded -rtsopts -Wall - - if flag(release) - ghc-options: -O2 -Werror - -flag release - description: Enable optimization and `-Werror` - default: False - manual: True - -library - import: language, opts-lib - hs-source-dirs: lib - build-depends: - , base - , bytestring - , cardano-addresses - , cardano-crypto-class - , cardano-ledger-allegra - , cardano-ledger-alonzo - , cardano-ledger-babbage - , cardano-ledger-core - , cardano-ledger-mary - , cardano-ledger-shelley - , cardano-ledger-shelley-ma - , cardano-slotting - , cardano-strict-containers - , cardano-wallet-primitive - , containers - , fmt - , generic-lens - , int-cast - , ouroboros-consensus-cardano - - exposed-modules: - --- Cardano.Wallet.Shelley.Compatibility.Ledger - -test-suite test - import: language, opts-exe - ghc-options: -with-rtsopts=-M2G -with-rtsopts=-N4 - type: exitcode-stdio-1.0 - hs-source-dirs: test/spec - main-is: run-test-suite.hs - build-depends: - , base - , bytestring - , cardano-addresses - , cardano-ledger-allegra:{cardano-ledger-allegra, testlib} - , cardano-wallet-conversions - , cardano-wallet-primitive - , cardano-wallet-test-utils - , hspec - , hspec-core - , ouroboros-consensus-cardano - , QuickCheck - , with-utf8 - - build-tool-depends: hspec-discover:hspec-discover - other-modules: - Spec - SpecHook - --- Cardano.Wallet.Shelley.Compatibility.LedgerSpec diff --git a/lib/conversions/lib/Cardano/Wallet/Shelley/Compatibility/Ledger.hs b/lib/conversions/lib/Cardano/Wallet/Shelley/Compatibility/Ledger.hs deleted file mode 100644 index a21edb8e893..00000000000 --- a/lib/conversions/lib/Cardano/Wallet/Shelley/Compatibility/Ledger.hs +++ /dev/null @@ -1,472 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE TypeApplications #-} - --- | --- Copyright: © 2020 IOHK --- License: Apache-2.0 --- --- Exposes a wallet-friendly interface to types and functions exported by the --- ledger specification. --- -module Cardano.Wallet.Shelley.Compatibility.Ledger - ( - -- * Conversions from wallet types to ledger specification types - toLedgerAddress - , toLedgerCoin - , toLedgerTokenBundle - , toLedgerTokenPolicyId - , toLedgerTokenName - , toLedgerTokenQuantity - , toLedgerTimelockScript - - -- * Conversions from ledger specification types to wallet types - , toWalletAddress - , toWalletCoin - , toWalletTokenBundle - , toWalletTokenPolicyId - , toWalletTokenName - , toWalletTokenQuantity - , toWalletScript - , toWalletScriptFromShelley - - -- * Roundtrip conversion between wallet types and ledger specification - -- types - , Convert (..) - - -- * Conversions for transaction outputs - , toShelleyTxOut - , toAllegraTxOut - , toMaryTxOut - , toAlonzoTxOut - , toBabbageTxOut - , toConwayTxOut - , fromBabbageTxOut - , fromConwayTxOut - ) where - -import Prelude - -import Cardano.Address.Script - ( KeyHash (..) - , KeyRole (..) - , Script (..) - ) -import Cardano.Crypto.Hash - ( hashFromBytes - , hashToBytes - ) -import Cardano.Slotting.Slot - ( SlotNo (..) - ) -import Cardano.Wallet.Primitive.Types.Address - ( Address (..) - ) -import Cardano.Wallet.Primitive.Types.Coin - ( Coin (..) - ) -import Cardano.Wallet.Primitive.Types.Hash - ( Hash (..) - ) -import Cardano.Wallet.Primitive.Types.TokenBundle - ( TokenBundle (..) - ) -import Cardano.Wallet.Primitive.Types.TokenPolicy - ( TokenName (..) - , TokenPolicyId (..) - ) -import Cardano.Wallet.Primitive.Types.TokenQuantity - ( TokenQuantity (..) - ) -import Cardano.Wallet.Primitive.Types.Tx.TxIn - ( TxIn (..) - ) -import Cardano.Wallet.Primitive.Types.Tx.TxOut - ( TxOut (..) - ) -import Data.ByteString.Short - ( fromShort - , toShort - ) -import Data.Foldable - ( toList - ) -import Data.Function - ( (&) - ) -import Data.Generics.Internal.VL.Lens - ( view - ) -import Data.Generics.Labels - () -import Data.IntCast - ( intCast - , intCastMaybe - ) -import Data.Maybe - ( fromMaybe - ) -import Fmt - ( pretty - ) -import GHC.Stack - ( HasCallStack - ) -import Numeric.Natural - ( Natural - ) -import Ouroboros.Consensus.Shelley.Eras - ( StandardAllegra - , StandardAlonzo - , StandardBabbage - , StandardConway - , StandardCrypto - , StandardMary - , StandardShelley - ) - -import qualified Cardano.Crypto.Hash.Class as Crypto -import qualified Cardano.Ledger.Address as Ledger -import qualified Cardano.Ledger.Allegra.Scripts as Scripts -import qualified Cardano.Ledger.Alonzo as Alonzo -import qualified Cardano.Ledger.Alonzo.TxBody as Alonzo -import qualified Cardano.Ledger.Babbage as Babbage -import qualified Cardano.Ledger.Babbage.TxBody as Babbage -import qualified Cardano.Ledger.Core as LCore -import qualified Cardano.Ledger.Keys as Ledger -import qualified Cardano.Ledger.Mary.Value as Ledger -import qualified Cardano.Ledger.SafeHash as SafeHash -import qualified Cardano.Ledger.Shelley.API as Ledger -import qualified Cardano.Ledger.Shelley.TxBody as Shelley -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 - --------------------------------------------------------------------------------- --- Roundtrip conversion between wallet types and ledger specification types --------------------------------------------------------------------------------- - --- | Connects a wallet type with its equivalent ledger specification type. --- --- Instances of this class should satisfy the following laws: --- --- >>> toLedger . toWallet == id --- >>> toWallet . toLedger == id --- -class Convert wallet ledger | wallet -> ledger where - -- | Converts a value from a wallet type to the equivalent ledger - -- specification type. - toLedger - :: HasCallStack => wallet -> ledger - -- | Converts a value from a ledger specification type to the equivalent - -- wallet type. - toWallet - :: HasCallStack => ledger -> wallet - --------------------------------------------------------------------------------- --- Conversions for 'Coin' --------------------------------------------------------------------------------- - -instance Convert Coin Ledger.Coin where - toLedger = toLedgerCoin - toWallet = toWalletCoin - -toLedgerCoin :: Coin -> Ledger.Coin -toLedgerCoin (Coin c) = Ledger.Coin $ intCast @Natural @Integer c - -toWalletCoin :: HasCallStack => Ledger.Coin -> Coin -toWalletCoin (Ledger.Coin c) = Coin.unsafeFromIntegral c - --------------------------------------------------------------------------------- --- Conversions for 'TokenBundle' --------------------------------------------------------------------------------- - --- Values of the ledger specification's 'Value' type are constructed in a way --- that is similar to the wallet's 'TokenBundle' type. The ada quantity is --- stored as a separate value, and asset quantities are stored in a nested map. - -instance Convert TokenBundle (Ledger.MaryValue StandardCrypto) where - toLedger = toLedgerTokenBundle - toWallet = toWalletTokenBundle - -toLedgerTokenBundle :: TokenBundle -> Ledger.MaryValue StandardCrypto -toLedgerTokenBundle bundle = - Ledger.MaryValue ledgerAda ledgerTokens - where - (Ledger.Coin ledgerAda) = toLedgerCoin $ TokenBundle.getCoin bundle - ledgerTokens :: Ledger.MultiAsset StandardCrypto - ledgerTokens = bundle - & view #tokens - & TokenMap.toNestedMap - & Map.mapKeys toLedgerTokenPolicyId - & Map.map mapInner - & Ledger.MultiAsset - mapInner inner = inner - & Map.mapKeys toLedgerTokenName - & Map.map toLedgerTokenQuantity - -toWalletTokenBundle :: Ledger.MaryValue StandardCrypto -> TokenBundle -toWalletTokenBundle - (Ledger.MaryValue ledgerAda (Ledger.MultiAsset ledgerTokens)) = - TokenBundle.fromNestedMap (walletAda, walletTokens) - where - walletAda = toWalletCoin $ Ledger.Coin ledgerAda - walletTokens = ledgerTokens - & Map.mapKeys toWalletTokenPolicyId - & Map.map mapInner - mapInner inner = inner - & Map.mapKeys toWalletTokenName - & Map.map toWalletTokenQuantity - --------------------------------------------------------------------------------- --- Conversions for 'TokenName' --------------------------------------------------------------------------------- - -instance Convert TokenName Ledger.AssetName where - toLedger = toLedgerTokenName - toWallet = toWalletTokenName - -toLedgerTokenName :: TokenName -> Ledger.AssetName -toLedgerTokenName (UnsafeTokenName bytes) = - Ledger.AssetName $ toShort bytes - -toWalletTokenName :: Ledger.AssetName -> TokenName -toWalletTokenName (Ledger.AssetName bytes) = - UnsafeTokenName $ fromShort bytes - --------------------------------------------------------------------------------- --- Conversions for 'TokenPolicyId' --------------------------------------------------------------------------------- - -instance Convert TokenPolicyId (Ledger.PolicyID StandardCrypto) where - toLedger = toLedgerTokenPolicyId - toWallet = toWalletTokenPolicyId - -toLedgerTokenPolicyId :: TokenPolicyId -> Ledger.PolicyID StandardCrypto -toLedgerTokenPolicyId p@(UnsafeTokenPolicyId (Hash bytes)) = - case hashFromBytes bytes of - Just hash -> - Ledger.PolicyID (Ledger.ScriptHash hash) - Nothing -> - error $ unwords - [ "Ledger.toLedgerTokenPolicyId" - , "Unable to construct hash for token policy:" - , pretty p - ] - -toWalletTokenPolicyId :: Ledger.PolicyID StandardCrypto -> TokenPolicyId -toWalletTokenPolicyId (Ledger.PolicyID (Ledger.ScriptHash hash)) = - UnsafeTokenPolicyId (Hash (hashToBytes hash)) - --------------------------------------------------------------------------------- --- Conversions for 'TokenQuantity' --------------------------------------------------------------------------------- - -instance Convert TokenQuantity Integer where - toLedger = toLedgerTokenQuantity - toWallet = toWalletTokenQuantity - -toLedgerTokenQuantity :: TokenQuantity -> Integer -toLedgerTokenQuantity (TokenQuantity q) = fromIntegral q - -toWalletTokenQuantity :: Integer -> TokenQuantity -toWalletTokenQuantity q - | q >= 0 = - TokenQuantity $ fromIntegral q - | otherwise = - error $ unwords - [ "Ledger.toWalletTokenQuantity:" - , "Unexpected negative value:" - , pretty q - ] - --------------------------------------------------------------------------------- --- Conversions for 'TxIn' --------------------------------------------------------------------------------- - -instance Convert TxIn (Ledger.TxIn StandardCrypto) where - toLedger (TxIn tid ix) = - Ledger.TxIn (toLedgerHash tid) (toEnum $ intCast ix) - where - toLedgerHash (Hash h) = - Ledger.TxId - $ SafeHash.unsafeMakeSafeHash - $ Crypto.UnsafeHash - $ toShort h - - toWallet (Ledger.TxIn (Ledger.TxId tid) ix) = - TxIn (convertId tid) (convertIx ix) - where - convertId = Hash . Crypto.hashToBytes . SafeHash.extractHash - - convertIx = fromMaybe err . intCastMaybe . fromEnum - where - err = error $ unwords - [ "Ledger.toWallet @TxIn:" - , "Unexpected out of bounds TxIx" - , show ix - ] - --------------------------------------------------------------------------------- --- Conversions for 'Address' --------------------------------------------------------------------------------- - -instance Convert Address (Ledger.Addr StandardCrypto) where - toLedger = toLedgerAddress - toWallet = toWalletAddress - -toLedgerAddress :: Address -> Ledger.Addr StandardCrypto -toLedgerAddress (Address bytes) = case Ledger.deserialiseAddr bytes of - Just addr -> addr - Nothing -> error $ unwords - [ "toLedger @Address: Invalid address:" - , pretty (Address bytes) - ] - -toWalletAddress :: Ledger.Addr StandardCrypto -> Address -toWalletAddress = Address . Ledger.serialiseAddr - --------------------------------------------------------------------------------- --- Conversions for 'TxOut' --------------------------------------------------------------------------------- - -toShelleyTxOut - :: TxOut - -> Shelley.ShelleyTxOut StandardShelley -toShelleyTxOut (TxOut addr bundle) = - Shelley.ShelleyTxOut (toLedger addr) (toLedger (TokenBundle.coin bundle)) - -toAllegraTxOut - :: TxOut - -> Shelley.ShelleyTxOut StandardAllegra -toAllegraTxOut (TxOut addr bundle) = - Shelley.ShelleyTxOut (toLedger addr) (toLedger (TokenBundle.coin bundle)) - -toMaryTxOut - :: TxOut - -> Shelley.ShelleyTxOut StandardMary -toMaryTxOut (TxOut addr bundle) = - Shelley.ShelleyTxOut (toLedger addr) (toLedger bundle) - -toAlonzoTxOut - :: TxOut - -> Alonzo.AlonzoTxOut StandardAlonzo -toAlonzoTxOut (TxOut addr bundle) = - Alonzo.AlonzoTxOut - (toLedger addr) - (toLedger bundle) - Ledger.SNothing - -toBabbageTxOut - :: HasCallStack - => TxOut - -> Babbage.BabbageTxOut StandardBabbage -toBabbageTxOut (TxOut addr bundle) = - Babbage.BabbageTxOut - (toLedger addr) - (toLedger bundle) - Babbage.NoDatum - Ledger.SNothing - -toConwayTxOut - :: TxOut - -> Babbage.BabbageTxOut StandardConway -toConwayTxOut (TxOut addr bundle) = - Babbage.BabbageTxOut - (toLedger addr) - (toLedger bundle) - Babbage.NoDatum - Ledger.SNothing - --- NOTE: Inline scripts and datums will be lost in the conversion. -fromConwayTxOut - :: Babbage.BabbageTxOut StandardConway - -> TxOut -fromConwayTxOut (Babbage.BabbageTxOut addr val _ _) - = TxOut (toWallet addr) (toWallet val) - --- NOTE: Inline scripts and datums will be lost in the conversion. -fromBabbageTxOut - :: Babbage.BabbageTxOut StandardBabbage - -> TxOut -fromBabbageTxOut (Babbage.BabbageTxOut addr val _ _) - = TxOut (toWallet addr) (toWallet val) - -toWalletScript - :: LCore.Era crypto - => (Hash "VerificationKey" -> KeyRole) - -> Scripts.Timelock crypto - -> Script KeyHash -toWalletScript tokeyrole = fromLedgerScript - where - fromLedgerScript (Scripts.RequireSignature (Ledger.KeyHash h)) = - let payload = hashToBytes h - in RequireSignatureOf (KeyHash (tokeyrole (Hash payload)) payload) - fromLedgerScript (Scripts.RequireAllOf contents) = - RequireAllOf $ map fromLedgerScript $ toList contents - fromLedgerScript (Scripts.RequireAnyOf contents) = - RequireAnyOf $ map fromLedgerScript $ toList contents - fromLedgerScript (Scripts.RequireMOf num contents) = - RequireSomeOf (fromIntegral num) $ fromLedgerScript <$> toList contents - fromLedgerScript (Scripts.RequireTimeExpire (SlotNo slot)) = - ActiveUntilSlot $ fromIntegral slot - fromLedgerScript (Scripts.RequireTimeStart (SlotNo slot)) = - ActiveFromSlot $ fromIntegral slot - -toWalletScriptFromShelley - :: LCore.Era crypto - => KeyRole - -> Ledger.MultiSig crypto - -> Script KeyHash -toWalletScriptFromShelley keyrole = fromLedgerScript' - where - fromLedgerScript' (Ledger.RequireSignature (Ledger.KeyHash h)) = - RequireSignatureOf (KeyHash keyrole (hashToBytes h)) - fromLedgerScript' (Ledger.RequireAllOf contents) = - RequireAllOf $ map fromLedgerScript' $ toList contents - fromLedgerScript' (Ledger.RequireAnyOf contents) = - 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 -> SlotNo - convertSlotNo x = SlotNo $ fromMaybe err $ intCastMaybe x - where - err = error $ unwords - [ "toLedgerTimelockScript:" - , "Unexpected out of bounds SlotNo" - , show x - ] diff --git a/lib/conversions/test/spec/Cardano/Wallet/Shelley/Compatibility/LedgerSpec.hs b/lib/conversions/test/spec/Cardano/Wallet/Shelley/Compatibility/LedgerSpec.hs deleted file mode 100644 index 28c2fb4089d..00000000000 --- a/lib/conversions/test/spec/Cardano/Wallet/Shelley/Compatibility/LedgerSpec.hs +++ /dev/null @@ -1,194 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module Cardano.Wallet.Shelley.Compatibility.LedgerSpec - ( spec - ) where - -import Prelude - -import Cardano.Address.Script - ( KeyHash (..) - , KeyRole (..) - , Script (..) - ) -import Cardano.Wallet.Primitive.Types.Coin - ( Coin (..) - ) -import Cardano.Wallet.Primitive.Types.TokenBundle - ( TokenBundle - ) -import Cardano.Wallet.Primitive.Types.TokenBundle.Gen - ( genTokenBundleSmallRange - , shrinkTokenBundleSmallRange - ) -import Cardano.Wallet.Primitive.Types.TokenPolicy - ( TokenName - , TokenPolicyId - ) -import Cardano.Wallet.Primitive.Types.TokenPolicy.Gen - ( genTokenNameLargeRange - , genTokenPolicyIdLargeRange - ) -import Cardano.Wallet.Primitive.Types.TokenQuantity - ( TokenQuantity (..) - ) -import Cardano.Wallet.Primitive.Types.TokenQuantity.Gen - ( genTokenQuantityFullRange - , shrinkTokenQuantityFullRange - ) -import Cardano.Wallet.Primitive.Types.Tx.TxIn - ( TxIn (..) - ) -import Cardano.Wallet.Primitive.Types.Tx.TxIn.Gen - ( genTxIn - , shrinkTxIn - ) -import Cardano.Wallet.Primitive.Types.Tx.TxOut.Gen - ( genTxOutCoin - , shrinkTxOutCoin - ) -import Cardano.Wallet.Shelley.Compatibility.Ledger - ( Convert (..) - , toLedgerTimelockScript - , toWalletScript - ) -import Data.Proxy - ( Proxy (..) - ) -import Data.Typeable - ( Typeable - , typeRep - ) -import Ouroboros.Consensus.Shelley.Eras - ( StandardBabbage - ) -import Test.Cardano.Ledger.Allegra.Arbitrary - () -import Test.Hspec - ( Spec - , describe - , it - ) -import Test.Hspec.Core.QuickCheck - ( modifyMaxSuccess - ) -import Test.QuickCheck - ( Arbitrary (..) - , Gen - , Positive (Positive) - , arbitrarySizedNatural - , choose - , elements - , oneof - , property - , scale - , sized - , vectorOf - , (===) - ) - -import qualified Data.ByteString as BS - -spec :: Spec -spec = describe "Cardano.Wallet.Shelley.Compatibility.LedgerSpec" $ - - modifyMaxSuccess (const 1000) $ do - - describe "Roundtrip conversions" $ do - - ledgerRoundtrip $ Proxy @Coin - ledgerRoundtrip $ Proxy @TokenBundle - ledgerRoundtrip $ Proxy @TokenName - ledgerRoundtrip $ Proxy @TokenPolicyId - ledgerRoundtrip $ Proxy @TokenQuantity - ledgerRoundtrip $ Proxy @TxIn - - describe "Timelock roundtrips (toLedgerTimelockScript, toWalletScript)" $ do - let ledger = toLedgerTimelockScript @StandardBabbage - let wallet = toWalletScript (const Unknown) - - it "ledger . wallet . ledger == ledger" $ property $ \s -> do - -- Ignore key role by doing one extra conversion - ledger (wallet $ ledger s) === ledger s - - it "ledger . wallet == id" $ property $ \s -> do - ledger (wallet s) === s - --------------------------------------------------------------------------------- --- Utilities --------------------------------------------------------------------------------- - -ledgerRoundtrip - :: forall w l. (Arbitrary w, Eq w, Show w, Typeable w, Convert w l) - => Proxy w - -> Spec -ledgerRoundtrip proxy = it title $ - property $ \a -> toWallet (toLedger @w a) === a - where - title = mconcat - [ "Can perform roundtrip conversion for values of type '" - , show (typeRep proxy) - , "'" - ] - --------------------------------------------------------------------------------- --- Arbitraries --------------------------------------------------------------------------------- - -instance Arbitrary Coin where - -- This instance is used to test roundtrip conversions, so it's important - -- that we generate coins across the full range available. - arbitrary = genTxOutCoin - shrink = shrinkTxOutCoin - -instance Arbitrary TokenBundle where - arbitrary = genTokenBundleSmallRange - shrink = shrinkTokenBundleSmallRange - -instance Arbitrary TokenName where - arbitrary = genTokenNameLargeRange - -- No shrinking - -instance Arbitrary TokenPolicyId where - arbitrary = genTokenPolicyIdLargeRange - -- No shrinking - -instance Arbitrary TokenQuantity where - arbitrary = genTokenQuantityFullRange - shrink = shrinkTokenQuantityFullRange - -instance Arbitrary TxIn where - arbitrary = genTxIn - shrink = shrinkTxIn - -instance Arbitrary (Script KeyHash) where - arbitrary = do - keyHashes <- vectorOf 10 arbitrary - genScript keyHashes - where - genScript :: [a] -> Gen (Script a) - genScript elems = scale (`div` 3) $ sized scriptTree - where - scriptTree 0 = oneof - [ RequireSignatureOf <$> elements elems - , ActiveFromSlot <$> arbitrarySizedNatural - , ActiveUntilSlot <$> arbitrarySizedNatural - ] - scriptTree n = do - Positive m <- arbitrary - let n' = n `div` (m + 1) - scripts' <- vectorOf m (scriptTree n') - atLeast <- choose (1, fromIntegral m) - elements - [ RequireAllOf scripts' - , RequireAnyOf scripts' - , RequireSomeOf atLeast scripts' - ] - -instance Arbitrary KeyHash where - arbitrary = do - cred <- elements [Payment, Delegation, Policy, Unknown] - KeyHash cred . BS.pack <$> vectorOf 28 arbitrary diff --git a/lib/conversions/test/spec/Spec.hs b/lib/conversions/test/spec/Spec.hs deleted file mode 100644 index 5416ef6a866..00000000000 --- a/lib/conversions/test/spec/Spec.hs +++ /dev/null @@ -1 +0,0 @@ -{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-} diff --git a/lib/conversions/test/spec/SpecHook.hs b/lib/conversions/test/spec/SpecHook.hs deleted file mode 100644 index cf456f4bf9f..00000000000 --- a/lib/conversions/test/spec/SpecHook.hs +++ /dev/null @@ -1,10 +0,0 @@ -module SpecHook where - -import Test.Hspec - --- Run all tests in parallel by default. --- --- See: https://hspec.github.io/parallel-spec-execution.html --- -hook :: Spec -> Spec -hook = parallel diff --git a/lib/conversions/test/spec/run-test-suite.hs b/lib/conversions/test/spec/run-test-suite.hs deleted file mode 100644 index 66edcab2e95..00000000000 --- a/lib/conversions/test/spec/run-test-suite.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Main where - -import Prelude - -import Main.Utf8 - ( withUtf8 - ) -import Test.Hspec.Extra - ( hspecMain - ) - -import qualified Spec - -main :: IO () -main = withUtf8 $ hspecMain Spec.spec diff --git a/lib/wallet/cardano-wallet.cabal b/lib/wallet/cardano-wallet.cabal index 18694521338..a1ce0395259 100644 --- a/lib/wallet/cardano-wallet.cabal +++ b/lib/wallet/cardano-wallet.cabal @@ -95,7 +95,6 @@ library , cardano-slotting , cardano-strict-containers , cardano-wallet-application-extras - , cardano-wallet-conversions , cardano-wallet-launcher , cardano-wallet-primitive , cardano-wallet-read @@ -219,10 +218,10 @@ library Cardano.DB.Sqlite.ForeignKeys Cardano.DB.Sqlite.Migration.Old Cardano.Pool.DB + Cardano.Pool.DB.Layer Cardano.Pool.DB.Log Cardano.Pool.DB.Model Cardano.Pool.DB.MVar - Cardano.Pool.DB.Layer Cardano.Pool.DB.Sqlite.TH Cardano.Pool.Metadata Cardano.Pool.Metadata.Types @@ -401,7 +400,6 @@ library cardano-wallet-api-http , cardano-ledger-shelley , cardano-wallet , cardano-wallet-application-extras - , cardano-wallet-conversions , cardano-wallet-launcher , cardano-wallet-primitive , cardano-wallet-read @@ -735,7 +733,6 @@ test-suite unit , cardano-wallet , cardano-wallet-api-http , cardano-wallet-application-extras - , cardano-wallet-conversions , cardano-wallet-launcher , cardano-wallet-primitive , cardano-wallet-read @@ -853,9 +850,9 @@ test-suite unit Cardano.CLISpec Cardano.DB.Sqlite.DeleteSpec Cardano.Pool.DB.Arbitrary + Cardano.Pool.DB.LayerSpec Cardano.Pool.DB.MVarSpec Cardano.Pool.DB.Properties - Cardano.Pool.DB.LayerSpec Cardano.Pool.RankSpec Cardano.Wallet.Address.Derivation.ByronSpec Cardano.Wallet.Address.Derivation.IcarusSpec From 7ce1aa3d539104c9c674c7254d1353d28754e9a6 Mon Sep 17 00:00:00 2001 From: paolino Date: Thu, 23 Nov 2023 09:28:54 +0000 Subject: [PATCH 3/3] Rename Cardano.Wallet.Shelley.Compatibility.Ledger in Cardano.Wallet.Primitive.Convert --- cabal.project | 1 - .../lib/internal/Internal/Cardano/Write/Tx.hs | 2 +- .../internal/Internal/Cardano/Write/Tx/Balance.hs | 2 +- .../Cardano/Write/Tx/Balance/TokenBundleSize.hs | 2 +- .../lib/internal/Internal/Cardano/Write/Tx/Sign.hs | 2 +- lib/primitive/cardano-wallet-primitive.cabal | 4 ++-- .../Ledger.hs => Primitive/Convert.hs} | 2 +- .../LedgerSpec.hs => Primitive/ConvertSpec.hs} | 14 +++++++------- .../http/Cardano/Wallet/Api/Http/Server/Error.hs | 12 ++++++------ .../http/Cardano/Wallet/Api/Http/Shelley/Server.hs | 8 ++++---- lib/wallet/src/Cardano/Wallet.hs | 10 +++++----- .../Cardano/Wallet/Address/Discovery/RandomAny.hs | 6 +++--- .../Wallet/Address/Discovery/SequentialAny.hs | 6 +++--- .../Cardano/Wallet/Read/Primitive/Tx/Allegra.hs | 8 ++++---- .../src/Cardano/Wallet/Read/Primitive/Tx/Alonzo.hs | 8 ++++---- .../Cardano/Wallet/Read/Primitive/Tx/Babbage.hs | 10 +++++----- .../src/Cardano/Wallet/Read/Primitive/Tx/Conway.hs | 10 +++++----- .../Primitive/Tx/Features/CollateralOutputs.hs | 6 +++--- .../Wallet/Read/Primitive/Tx/Features/Fee.hs | 2 +- .../Wallet/Read/Primitive/Tx/Features/Mint.hs | 12 ++++++------ .../Wallet/Read/Primitive/Tx/Features/Outputs.hs | 8 ++++---- .../Read/Primitive/Tx/Features/Withdrawals.hs | 2 +- .../src/Cardano/Wallet/Read/Primitive/Tx/Mary.hs | 8 ++++---- .../Cardano/Wallet/Read/Primitive/Tx/Shelley.hs | 8 ++++---- .../src/Cardano/Wallet/Shelley/Compatibility.hs | 2 +- .../src/Cardano/Wallet/Shelley/Network/Node.hs | 2 +- .../src/Cardano/Wallet/Shelley/Transaction.hs | 8 ++++---- .../unit/Internal/Cardano/Write/Tx/BalanceSpec.hs | 2 +- 28 files changed, 83 insertions(+), 84 deletions(-) rename lib/primitive/lib/Cardano/Wallet/{Shelley/Compatibility/Ledger.hs => Primitive/Convert.hs} (99%) rename lib/primitive/test/spec/Cardano/Wallet/{Shelley/Compatibility/LedgerSpec.hs => Primitive/ConvertSpec.hs} (96%) diff --git a/cabal.project b/cabal.project index d6409eef3a6..6342607bb95 100644 --- a/cabal.project +++ b/cabal.project @@ -63,7 +63,6 @@ packages: , lib/cardano-api-extra/ , lib/crypto-hash-extra/ , lib/coin-selection/ - , lib/conversions/ , lib/customer-deposit-wallet/ , lib/delta-store/ , lib/delta-table diff --git a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx.hs b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx.hs index eae957490d2..bfcc6ec4434 100644 --- a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx.hs +++ b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx.hs @@ -282,10 +282,10 @@ import qualified Cardano.Ledger.Keys as Ledger import qualified Cardano.Ledger.Shelley.API.Wallet as Shelley import qualified Cardano.Ledger.Shelley.UTxO as Shelley import qualified Cardano.Ledger.TxIn as Ledger +import qualified Cardano.Wallet.Primitive.Convert as Convert import qualified Cardano.Wallet.Primitive.Types.Tx.Constraints as W ( txOutMaxCoin ) -import qualified Cardano.Wallet.Shelley.Compatibility.Ledger as Convert import qualified Data.Map as Map -------------------------------------------------------------------------------- diff --git a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Balance.hs b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Balance.hs index 44f9d3a3d10..8fcfb5e99f1 100644 --- a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Balance.hs +++ b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Balance.hs @@ -291,6 +291,7 @@ import qualified Cardano.Api.Shelley as CardanoApi import qualified Cardano.CoinSelection.UTxOIndex as UTxOIndex import qualified Cardano.CoinSelection.UTxOSelection as UTxOSelection import qualified Cardano.Ledger.Core as Core +import qualified Cardano.Wallet.Primitive.Convert as Convert import qualified Cardano.Wallet.Primitive.Types.Address as W ( Address ) @@ -325,7 +326,6 @@ import qualified Cardano.Wallet.Primitive.Types.UTxO as W.UTxO import qualified Cardano.Wallet.Primitive.Types.UTxO as W ( UTxO (..) ) -import qualified Cardano.Wallet.Shelley.Compatibility.Ledger as Convert import qualified Data.Foldable as F import qualified Data.List as L import qualified Data.Map as Map diff --git a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Balance/TokenBundleSize.hs b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Balance/TokenBundleSize.hs index 470a72778f2..e034c33674d 100644 --- a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Balance/TokenBundleSize.hs +++ b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Balance/TokenBundleSize.hs @@ -35,13 +35,13 @@ import Internal.Cardano.Write.Tx , Version ) +import qualified Cardano.Wallet.Primitive.Convert as Convert import qualified Cardano.Wallet.Primitive.Types.TokenBundle as W ( TokenBundle ) import qualified Cardano.Wallet.Primitive.Types.Tx.Constraints as W ( TxSize (..) ) -import qualified Cardano.Wallet.Shelley.Compatibility.Ledger as Convert import qualified Data.ByteString.Lazy as BL -- | Assesses a token bundle size in relation to the maximum size that can be diff --git a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Sign.hs b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Sign.hs index 5bba1d8d9f7..909749ea335 100644 --- a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Sign.hs +++ b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Sign.hs @@ -74,13 +74,13 @@ import qualified Cardano.Api.Byron as CardanoApi import qualified Cardano.Api.Shelley as CardanoApi import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo import qualified Cardano.Ledger.Api as Ledger +import qualified Cardano.Wallet.Primitive.Convert as Convert import qualified Cardano.Wallet.Primitive.Types.Coin as W ( Coin (..) ) import qualified Cardano.Wallet.Primitive.Types.Tx.Constraints as W ( TxSize (..) ) -import qualified Cardano.Wallet.Shelley.Compatibility.Ledger as Convert import qualified Data.Foldable as F import qualified Data.List as L import qualified Data.Map as Map diff --git a/lib/primitive/cardano-wallet-primitive.cabal b/lib/primitive/cardano-wallet-primitive.cabal index cca54102c6d..4a2e62cce08 100644 --- a/lib/primitive/cardano-wallet-primitive.cabal +++ b/lib/primitive/cardano-wallet-primitive.cabal @@ -104,6 +104,7 @@ library exposed-modules: Cardano.Wallet.Orphans Cardano.Wallet.Primitive.Collateral + Cardano.Wallet.Primitive.Convert Cardano.Wallet.Primitive.NetworkId Cardano.Wallet.Primitive.Slotting Cardano.Wallet.Primitive.Slotting.Legacy @@ -155,7 +156,6 @@ library Cardano.Wallet.Primitive.Types.TxParameters Cardano.Wallet.Primitive.Types.UTxO Cardano.Wallet.Primitive.Types.UTxO.Gen - Cardano.Wallet.Shelley.Compatibility.Ledger Cardano.Wallet.Unsafe Cardano.Wallet.Util Control.Monad.Random.NonRandom @@ -217,6 +217,7 @@ test-suite test build-tool-depends: hspec-discover:hspec-discover other-modules: Cardano.Wallet.Primitive.CollateralSpec + Cardano.Wallet.Primitive.ConvertSpec Cardano.Wallet.Primitive.SlottingSpec Cardano.Wallet.Primitive.SyncProgressSpec Cardano.Wallet.Primitive.Types.AddressSpec @@ -231,7 +232,6 @@ test-suite test Cardano.Wallet.Primitive.Types.TokenQuantitySpec Cardano.Wallet.Primitive.Types.TxSpec Cardano.Wallet.Primitive.Types.UTxOSpec - Cardano.Wallet.Shelley.Compatibility.LedgerSpec Data.QuantitySpec Spec SpecHook diff --git a/lib/primitive/lib/Cardano/Wallet/Shelley/Compatibility/Ledger.hs b/lib/primitive/lib/Cardano/Wallet/Primitive/Convert.hs similarity index 99% rename from lib/primitive/lib/Cardano/Wallet/Shelley/Compatibility/Ledger.hs rename to lib/primitive/lib/Cardano/Wallet/Primitive/Convert.hs index a21edb8e893..a064ec59684 100644 --- a/lib/primitive/lib/Cardano/Wallet/Shelley/Compatibility/Ledger.hs +++ b/lib/primitive/lib/Cardano/Wallet/Primitive/Convert.hs @@ -12,7 +12,7 @@ -- Exposes a wallet-friendly interface to types and functions exported by the -- ledger specification. -- -module Cardano.Wallet.Shelley.Compatibility.Ledger +module Cardano.Wallet.Primitive.Convert ( -- * Conversions from wallet types to ledger specification types toLedgerAddress diff --git a/lib/primitive/test/spec/Cardano/Wallet/Shelley/Compatibility/LedgerSpec.hs b/lib/primitive/test/spec/Cardano/Wallet/Primitive/ConvertSpec.hs similarity index 96% rename from lib/primitive/test/spec/Cardano/Wallet/Shelley/Compatibility/LedgerSpec.hs rename to lib/primitive/test/spec/Cardano/Wallet/Primitive/ConvertSpec.hs index 28c2fb4089d..873fe29d836 100644 --- a/lib/primitive/test/spec/Cardano/Wallet/Shelley/Compatibility/LedgerSpec.hs +++ b/lib/primitive/test/spec/Cardano/Wallet/Primitive/ConvertSpec.hs @@ -3,7 +3,7 @@ {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module Cardano.Wallet.Shelley.Compatibility.LedgerSpec +module Cardano.Wallet.Primitive.ConvertSpec ( spec ) where @@ -14,6 +14,11 @@ import Cardano.Address.Script , KeyRole (..) , Script (..) ) +import Cardano.Wallet.Primitive.Convert + ( Convert (..) + , toLedgerTimelockScript + , toWalletScript + ) import Cardano.Wallet.Primitive.Types.Coin ( Coin (..) ) @@ -50,11 +55,6 @@ import Cardano.Wallet.Primitive.Types.Tx.TxOut.Gen ( genTxOutCoin , shrinkTxOutCoin ) -import Cardano.Wallet.Shelley.Compatibility.Ledger - ( Convert (..) - , toLedgerTimelockScript - , toWalletScript - ) import Data.Proxy ( Proxy (..) ) @@ -93,7 +93,7 @@ import Test.QuickCheck import qualified Data.ByteString as BS spec :: Spec -spec = describe "Cardano.Wallet.Shelley.Compatibility.LedgerSpec" $ +spec = describe "Cardano.Wallet.Primitive.ConvertSpec" $ modifyMaxSuccess (const 1000) $ do diff --git a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Error.hs b/lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Error.hs index ec0bfbe8acf..078abe421e3 100644 --- a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Error.hs +++ b/lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Error.hs @@ -101,18 +101,18 @@ import Cardano.Wallet.Api.Types.Error , ApiErrorSharedWalletNoSuchCosigner (..) , ApiErrorTxOutputLovelaceInsufficient (..) ) +import Cardano.Wallet.Primitive.Convert + ( Convert (toWallet) + , toWalletAddress + , toWalletCoin + , toWalletTokenBundle + ) import Cardano.Wallet.Primitive.Slotting ( PastHorizonException ) import Cardano.Wallet.Primitive.Types.TokenMap ( Flat (..) ) -import Cardano.Wallet.Shelley.Compatibility.Ledger - ( Convert (toWallet) - , toWalletAddress - , toWalletCoin - , toWalletTokenBundle - ) import Cardano.Wallet.Transaction ( ErrSignTx (..) ) diff --git a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs b/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs index 75495f98d53..045db5bd564 100644 --- a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs +++ b/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs @@ -520,6 +520,9 @@ import Cardano.Wallet.Pools ( EpochInfo (..) , toEpochInfo ) +import Cardano.Wallet.Primitive.Convert + ( toLedger + ) import Cardano.Wallet.Primitive.Delegation.UTxO ( stakeKeyCoinDistr ) @@ -639,9 +642,6 @@ import Cardano.Wallet.Registry , defaultWorkerAfter , workerResource ) -import Cardano.Wallet.Shelley.Compatibility.Ledger - ( toLedger - ) import Cardano.Wallet.Shelley.Transaction ( TxWitnessTag ) @@ -886,6 +886,7 @@ import qualified Cardano.Wallet.Api.Types as Api import qualified Cardano.Wallet.DB as W import qualified Cardano.Wallet.Delegation as WD import qualified Cardano.Wallet.Network as NW +import qualified Cardano.Wallet.Primitive.Convert as Convert import qualified Cardano.Wallet.Primitive.Types as W import qualified Cardano.Wallet.Primitive.Types.Coin as Coin import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle @@ -905,7 +906,6 @@ import qualified Cardano.Wallet.Primitive.Types.Tx.TxOut as TxOut import qualified Cardano.Wallet.Primitive.Types.UTxO as UTxO import qualified Cardano.Wallet.Read as Read import qualified Cardano.Wallet.Registry as Registry -import qualified Cardano.Wallet.Shelley.Compatibility.Ledger as Convert import qualified Control.Concurrent.Concierge as Concierge import qualified Data.ByteString as BS import qualified Data.Foldable as F diff --git a/lib/wallet/src/Cardano/Wallet.hs b/lib/wallet/src/Cardano/Wallet.hs index d521ac0b631..e917e8aa0c8 100644 --- a/lib/wallet/src/Cardano/Wallet.hs +++ b/lib/wallet/src/Cardano/Wallet.hs @@ -427,6 +427,11 @@ import Cardano.Wallet.Network , ErrPostTx (..) , NetworkLayer (..) ) +import Cardano.Wallet.Primitive.Convert + ( toLedgerAddress + , toWallet + , toWalletCoin + ) import Cardano.Wallet.Primitive.Model ( BlockData (..) , Wallet @@ -561,11 +566,6 @@ import Cardano.Wallet.Shelley.Compatibility , fromCardanoTxOut , fromCardanoWdrls ) -import Cardano.Wallet.Shelley.Compatibility.Ledger - ( toLedgerAddress - , toWallet - , toWalletCoin - ) import Cardano.Wallet.Shelley.Transaction ( mkTransaction , mkUnsignedTransaction diff --git a/lib/wallet/src/Cardano/Wallet/Address/Discovery/RandomAny.hs b/lib/wallet/src/Cardano/Wallet/Address/Discovery/RandomAny.hs index 4a1379f6fe4..6c6c94e6dd9 100644 --- a/lib/wallet/src/Cardano/Wallet/Address/Discovery/RandomAny.hs +++ b/lib/wallet/src/Cardano/Wallet/Address/Discovery/RandomAny.hs @@ -59,6 +59,9 @@ import Cardano.Wallet.Address.States.Families , KeyOf , NetworkOf ) +import Cardano.Wallet.Primitive.Convert + ( toLedger + ) import Cardano.Wallet.Primitive.NetworkId ( HasSNetworkId , NetworkDiscriminant @@ -70,9 +73,6 @@ import Cardano.Wallet.Primitive.Types.Address import Cardano.Wallet.Primitive.Types.RewardAccount ( RewardAccount ) -import Cardano.Wallet.Shelley.Compatibility.Ledger - ( toLedger - ) import Control.Arrow ( second ) diff --git a/lib/wallet/src/Cardano/Wallet/Address/Discovery/SequentialAny.hs b/lib/wallet/src/Cardano/Wallet/Address/Discovery/SequentialAny.hs index 088abc7852b..6e849fbd45b 100644 --- a/lib/wallet/src/Cardano/Wallet/Address/Discovery/SequentialAny.hs +++ b/lib/wallet/src/Cardano/Wallet/Address/Discovery/SequentialAny.hs @@ -77,6 +77,9 @@ import Cardano.Wallet.Address.States.Families , KeyOf , NetworkOf ) +import Cardano.Wallet.Primitive.Convert + ( toLedger + ) import Cardano.Wallet.Primitive.NetworkId ( HasSNetworkId (..) , NetworkDiscriminant @@ -87,9 +90,6 @@ import Cardano.Wallet.Primitive.Types.Address import Cardano.Wallet.Primitive.Types.RewardAccount ( RewardAccount ) -import Cardano.Wallet.Shelley.Compatibility.Ledger - ( toLedger - ) import Control.DeepSeq ( NFData (..) ) diff --git a/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Allegra.hs b/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Allegra.hs index 6f2350986e1..5e66e377e56 100644 --- a/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Allegra.hs +++ b/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Allegra.hs @@ -48,6 +48,9 @@ import Cardano.Ledger.Core import Cardano.Ledger.Shelley.Tx ( ShelleyTx ) +import Cardano.Wallet.Primitive.Convert + ( toWalletScript + ) import Cardano.Wallet.Read.Eras ( allegra , inject @@ -82,9 +85,6 @@ import Cardano.Wallet.Read.Tx.Hash import Cardano.Wallet.Read.Tx.Withdrawals ( shelleyWithdrawals ) -import Cardano.Wallet.Shelley.Compatibility.Ledger - ( toWalletScript - ) import Cardano.Wallet.Transaction ( AnyExplicitScript (..) , ScriptReference (..) @@ -104,10 +104,10 @@ import Data.Foldable import qualified Cardano.Api.Shelley as Cardano import qualified Cardano.Ledger.BaseTypes as SL +import qualified Cardano.Wallet.Primitive.Convert as Ledger import qualified Cardano.Wallet.Primitive.Types as W import qualified Cardano.Wallet.Primitive.Types.Hash as W import qualified Cardano.Wallet.Primitive.Types.Tx as W -import qualified Cardano.Wallet.Shelley.Compatibility.Ledger as Ledger import qualified Data.Set as Set -- NOTE: For resolved inputs we have to pass in a dummy value of 0. diff --git a/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Alonzo.hs b/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Alonzo.hs index 3605970c3f0..e1e67ab8b91 100644 --- a/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Alonzo.hs +++ b/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Alonzo.hs @@ -38,6 +38,9 @@ import Cardano.Ledger.Api , vldtTxBodyL , witsTxL ) +import Cardano.Wallet.Primitive.Convert + ( toWalletScript + ) import Cardano.Wallet.Read.Eras ( alonzo , inject @@ -76,9 +79,6 @@ import Cardano.Wallet.Read.Tx.Hash import Cardano.Wallet.Read.Tx.Withdrawals ( shelleyWithdrawals ) -import Cardano.Wallet.Shelley.Compatibility.Ledger - ( toWalletScript - ) import Cardano.Wallet.Transaction ( AnyExplicitScript (..) , PlutusScriptInfo (..) @@ -102,10 +102,10 @@ import qualified Cardano.Ledger.Alonzo.Tx as Alonzo import qualified Cardano.Ledger.BaseTypes as SL import qualified Cardano.Ledger.Core as Core import qualified Cardano.Ledger.Language as Language +import qualified Cardano.Wallet.Primitive.Convert as Ledger import qualified Cardano.Wallet.Primitive.Types as W import qualified Cardano.Wallet.Primitive.Types.Hash as W import qualified Cardano.Wallet.Primitive.Types.Tx as W -import qualified Cardano.Wallet.Shelley.Compatibility.Ledger as Ledger import qualified Data.Set as Set fromAlonzoTx diff --git a/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Babbage.hs b/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Babbage.hs index a5d62abc86a..3747617bbb5 100644 --- a/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Babbage.hs +++ b/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Babbage.hs @@ -43,6 +43,10 @@ import Cardano.Ledger.Api , vldtTxBodyL , witsTxL ) +import Cardano.Wallet.Primitive.Convert + ( toWalletScript + , toWalletTokenPolicyId + ) import Cardano.Wallet.Primitive.Types.TokenPolicy ( TokenPolicyId ) @@ -90,10 +94,6 @@ import Cardano.Wallet.Read.Tx.Hash import Cardano.Wallet.Read.Tx.Withdrawals ( shelleyWithdrawals ) -import Cardano.Wallet.Shelley.Compatibility.Ledger - ( toWalletScript - , toWalletTokenPolicyId - ) import Cardano.Wallet.Transaction ( AnyExplicitScript (..) , PlutusScriptInfo (..) @@ -134,10 +134,10 @@ import qualified Cardano.Ledger.BaseTypes as SL import qualified Cardano.Ledger.Core as Core import qualified Cardano.Ledger.Language as Language import qualified Cardano.Ledger.Mary.Value as SL +import qualified Cardano.Wallet.Primitive.Convert as Ledger import qualified Cardano.Wallet.Primitive.Types as W import qualified Cardano.Wallet.Primitive.Types.Hash as W import qualified Cardano.Wallet.Primitive.Types.Tx as W -import qualified Cardano.Wallet.Shelley.Compatibility.Ledger as Ledger import qualified Data.List as L import qualified Data.Map.Strict as Map import qualified Data.Set as Set diff --git a/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Conway.hs b/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Conway.hs index bd34b188c16..f257640f14b 100644 --- a/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Conway.hs +++ b/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Conway.hs @@ -46,6 +46,10 @@ import Cardano.Ledger.Api import Cardano.Ledger.Babbage ( BabbageTxOut ) +import Cardano.Wallet.Primitive.Convert + ( toWalletScript + , toWalletTokenPolicyId + ) import Cardano.Wallet.Primitive.Types.TokenPolicy ( TokenPolicyId (..) ) @@ -93,10 +97,6 @@ import Cardano.Wallet.Read.Tx.Hash import Cardano.Wallet.Read.Tx.Withdrawals ( shelleyWithdrawals ) -import Cardano.Wallet.Shelley.Compatibility.Ledger - ( toWalletScript - , toWalletTokenPolicyId - ) import Cardano.Wallet.Transaction ( AnyExplicitScript (..) , PlutusScriptInfo (..) @@ -139,10 +139,10 @@ import qualified Cardano.Ledger.BaseTypes as SL import qualified Cardano.Ledger.Core as Core import qualified Cardano.Ledger.Language as Language import qualified Cardano.Ledger.Mary.Value as SL +import qualified Cardano.Wallet.Primitive.Convert as Ledger import qualified Cardano.Wallet.Primitive.Types as W import qualified Cardano.Wallet.Primitive.Types.Hash as W import qualified Cardano.Wallet.Primitive.Types.Tx as W -import qualified Cardano.Wallet.Shelley.Compatibility.Ledger as Ledger import qualified Data.List as L import qualified Data.Map.Strict as Map import qualified Data.Set as Set diff --git a/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Features/CollateralOutputs.hs b/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Features/CollateralOutputs.hs index 8fe8068a4fd..6151ee5a7f2 100644 --- a/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Features/CollateralOutputs.hs +++ b/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Features/CollateralOutputs.hs @@ -7,6 +7,9 @@ module Cardano.Wallet.Read.Primitive.Tx.Features.CollateralOutputs import Prelude +import Cardano.Wallet.Primitive.Convert + ( toWalletTokenBundle + ) import Cardano.Wallet.Read.Eras ( EraFun (..) , K (..) @@ -17,9 +20,6 @@ import Cardano.Wallet.Read.Primitive.Tx.Features.Outputs import Cardano.Wallet.Read.Tx.CollateralOutputs ( CollateralOutputs (..) ) -import Cardano.Wallet.Shelley.Compatibility.Ledger - ( toWalletTokenBundle - ) import Data.Maybe.Strict ( strictMaybeToMaybe ) diff --git a/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Features/Fee.hs b/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Features/Fee.hs index 53f41e0a888..c2f691c6d32 100644 --- a/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Features/Fee.hs +++ b/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Features/Fee.hs @@ -18,8 +18,8 @@ import Cardano.Wallet.Read.Tx.Fee , FeeType ) +import qualified Cardano.Wallet.Primitive.Convert as Ledger import qualified Cardano.Wallet.Primitive.Types.Coin as W -import qualified Cardano.Wallet.Shelley.Compatibility.Ledger as Ledger getFee :: EraFun Fee (K (Maybe W.Coin)) getFee = EraFun diff --git a/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Features/Mint.hs b/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Features/Mint.hs index 622524ce939..ad1dbc01dcd 100644 --- a/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Features/Mint.hs +++ b/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Features/Mint.hs @@ -41,6 +41,12 @@ import Cardano.Ledger.Shelley.TxWits ( ShelleyTxWits , scriptWits ) +import Cardano.Wallet.Primitive.Convert + ( toWalletScript + , toWalletTokenName + , toWalletTokenPolicyId + , toWalletTokenQuantity + ) import Cardano.Wallet.Primitive.Types.Hash ( Hash (..) ) @@ -69,12 +75,6 @@ import Cardano.Wallet.Read.Tx.ReferenceInputs import Cardano.Wallet.Read.Tx.Witnesses ( Witnesses (..) ) -import Cardano.Wallet.Shelley.Compatibility.Ledger - ( toWalletScript - , toWalletTokenName - , toWalletTokenPolicyId - , toWalletTokenQuantity - ) import Cardano.Wallet.Transaction ( AnyScript (..) , PlutusScriptInfo (..) diff --git a/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Features/Outputs.hs b/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Features/Outputs.hs index 5e755b9e9a5..efbf220206b 100644 --- a/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Features/Outputs.hs +++ b/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Features/Outputs.hs @@ -28,6 +28,9 @@ import Cardano.Ledger.Alonzo import Cardano.Ledger.Shelley.API ( StrictMaybe (SJust, SNothing) ) +import Cardano.Wallet.Primitive.Convert + ( toWalletTokenBundle + ) import Cardano.Wallet.Read.Eras ( EraFun (..) , K (..) @@ -35,9 +38,6 @@ import Cardano.Wallet.Read.Eras import Cardano.Wallet.Read.Tx.Outputs ( Outputs (..) ) -import Cardano.Wallet.Shelley.Compatibility.Ledger - ( toWalletTokenBundle - ) import Cardano.Wallet.Util ( internalError ) @@ -66,6 +66,7 @@ import qualified Cardano.Ledger.Babbage.TxBody as Babbage import qualified Cardano.Ledger.Conway as Conway import qualified Cardano.Ledger.Crypto as SL import qualified Cardano.Ledger.Shelley.API as SL +import qualified Cardano.Wallet.Primitive.Convert as Ledger import qualified Cardano.Wallet.Primitive.Types.Address as W import qualified Cardano.Wallet.Primitive.Types.Coin as Coin import qualified Cardano.Wallet.Primitive.Types.Coin as W @@ -74,7 +75,6 @@ import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle import qualified Cardano.Wallet.Primitive.Types.TokenPolicy as W import qualified Cardano.Wallet.Primitive.Types.TokenQuantity as W import qualified Cardano.Wallet.Primitive.Types.Tx.TxOut as W -import qualified Cardano.Wallet.Shelley.Compatibility.Ledger as Ledger getOutputs :: EraFun Outputs (K [W.TxOut]) getOutputs = EraFun diff --git a/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Features/Withdrawals.hs b/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Features/Withdrawals.hs index 051f2a85cad..72aaffd24cf 100644 --- a/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Features/Withdrawals.hs +++ b/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Features/Withdrawals.hs @@ -34,9 +34,9 @@ import Data.Map.Strict import qualified Cardano.Ledger.Api as Ledger import qualified Cardano.Ledger.Coin as Ledger +import qualified Cardano.Wallet.Primitive.Convert as Ledger import qualified Cardano.Wallet.Primitive.Types.Coin as W import qualified Cardano.Wallet.Read.Primitive.Tx.Features.Certificates as Certificates -import qualified Cardano.Wallet.Shelley.Compatibility.Ledger as Ledger import qualified Data.Map as Map getWithdrawals :: EraFun Withdrawals (K (Maybe (Map RewardAccount Coin))) diff --git a/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Mary.hs b/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Mary.hs index 25d3771e0aa..75d3a4a2400 100644 --- a/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Mary.hs +++ b/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Mary.hs @@ -33,6 +33,9 @@ import Cardano.Ledger.Api , vldtTxBodyL , witsTxL ) +import Cardano.Wallet.Primitive.Convert + ( toWalletScript + ) import Cardano.Wallet.Read.Eras ( inject , mary @@ -70,9 +73,6 @@ import Cardano.Wallet.Read.Tx.Hash import Cardano.Wallet.Read.Tx.Withdrawals ( shelleyWithdrawals ) -import Cardano.Wallet.Shelley.Compatibility.Ledger - ( toWalletScript - ) import Cardano.Wallet.Transaction ( AnyExplicitScript (..) , ScriptReference (..) @@ -91,10 +91,10 @@ import Control.Lens import qualified Cardano.Api.Shelley as Cardano import qualified Cardano.Ledger.BaseTypes as SL import qualified Cardano.Ledger.Shelley.API as SL +import qualified Cardano.Wallet.Primitive.Convert as Ledger import qualified Cardano.Wallet.Primitive.Types as W import qualified Cardano.Wallet.Primitive.Types.Hash as W import qualified Cardano.Wallet.Primitive.Types.Tx as W -import qualified Cardano.Wallet.Shelley.Compatibility.Ledger as Ledger import qualified Data.Set as Set fromMaryTx diff --git a/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Shelley.hs b/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Shelley.hs index ce7d886e29e..c6631dad250 100644 --- a/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Shelley.hs +++ b/lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Shelley.hs @@ -41,6 +41,9 @@ import Cardano.Ledger.Shelley.TxBody ( certsTxBodyL , ttlTxBodyL ) +import Cardano.Wallet.Primitive.Convert + ( toWalletScriptFromShelley + ) import Cardano.Wallet.Read.Eras ( inject , shelley @@ -73,9 +76,6 @@ import Cardano.Wallet.Read.Tx.Hash import Cardano.Wallet.Read.Tx.Withdrawals ( shelleyWithdrawals ) -import Cardano.Wallet.Shelley.Compatibility.Ledger - ( toWalletScriptFromShelley - ) import Cardano.Wallet.Transaction ( AnyExplicitScript (..) , ScriptReference (..) @@ -98,13 +98,13 @@ import Data.Word import qualified Cardano.Api.Shelley as Cardano import qualified Cardano.Ledger.BaseTypes as SL import qualified Cardano.Ledger.Shelley.API as SL +import qualified Cardano.Wallet.Primitive.Convert as Ledger import qualified Cardano.Wallet.Primitive.Types as W import qualified Cardano.Wallet.Primitive.Types.Hash as W import qualified Cardano.Wallet.Primitive.Types.Tx as W import qualified Cardano.Wallet.Primitive.Types.Tx.TxIn as W ( TxIn (TxIn) ) -import qualified Cardano.Wallet.Shelley.Compatibility.Ledger as Ledger import qualified Data.Set as Set fromShelleyTxIn diff --git a/lib/wallet/src/Cardano/Wallet/Shelley/Compatibility.hs b/lib/wallet/src/Cardano/Wallet/Shelley/Compatibility.hs index 362304ad034..14dca180c9e 100644 --- a/lib/wallet/src/Cardano/Wallet/Shelley/Compatibility.hs +++ b/lib/wallet/src/Cardano/Wallet/Shelley/Compatibility.hs @@ -383,6 +383,7 @@ import qualified Cardano.Ledger.Shelley.API as SL import qualified Cardano.Ledger.Shelley.API as SLAPI import qualified Cardano.Ledger.Shelley.BlockChain as SL import qualified Cardano.Protocol.TPraos.BHeader as SL +import qualified Cardano.Wallet.Primitive.Convert as Ledger import qualified Cardano.Wallet.Primitive.Types as W import qualified Cardano.Wallet.Primitive.Types.Address as W import qualified Cardano.Wallet.Primitive.Types.Coin as Coin @@ -407,7 +408,6 @@ import qualified Cardano.Wallet.Primitive.Types.Tx.TxOut as W ( TxOut (TxOut) ) import qualified Cardano.Wallet.Primitive.Types.UTxO as W -import qualified Cardano.Wallet.Shelley.Compatibility.Ledger as Ledger import qualified Data.Array as Array import qualified Data.ByteString as BS import qualified Data.ByteString.Short as SBS diff --git a/lib/wallet/src/Cardano/Wallet/Shelley/Network/Node.hs b/lib/wallet/src/Cardano/Wallet/Shelley/Network/Node.hs index af91a28ccfc..3fa7075ae3e 100644 --- a/lib/wallet/src/Cardano/Wallet/Shelley/Network/Node.hs +++ b/lib/wallet/src/Cardano/Wallet/Shelley/Network/Node.hs @@ -400,12 +400,12 @@ import qualified Cardano.Ledger.Credential as SL import qualified Cardano.Ledger.Crypto as SL import qualified Cardano.Ledger.Shelley.API as SL import qualified Cardano.Ledger.Shelley.LedgerState as SL +import qualified Cardano.Wallet.Primitive.Convert as Ledger import qualified Cardano.Wallet.Primitive.SyncProgress as SP import qualified Cardano.Wallet.Primitive.Types as W import qualified Cardano.Wallet.Primitive.Types.Coin as W import qualified Cardano.Wallet.Primitive.Types.RewardAccount as W import qualified Cardano.Wallet.Primitive.Types.Tx as W -import qualified Cardano.Wallet.Shelley.Compatibility.Ledger as Ledger import qualified Codec.CBOR.Term as CBOR import qualified Data.Map as Map import qualified Data.Set as Set diff --git a/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs b/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs index 13fd19197bc..aa00c31f380 100644 --- a/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs +++ b/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs @@ -98,6 +98,9 @@ import Cardano.Wallet.Address.Keys.WalletKey import Cardano.Wallet.Flavor ( KeyFlavorS (..) ) +import Cardano.Wallet.Primitive.Convert + ( Convert (toLedger) + ) import Cardano.Wallet.Primitive.Passphrase ( Passphrase (..) ) @@ -160,9 +163,6 @@ import Cardano.Wallet.Shelley.Compatibility , toStakeKeyRegCert , toStakePoolDlgCert ) -import Cardano.Wallet.Shelley.Compatibility.Ledger - ( Convert (toLedger) - ) import Cardano.Wallet.Transaction ( AnyExplicitScript (..) , AnyScript (..) @@ -250,9 +250,9 @@ import qualified Cardano.Crypto.Hash.Class as Crypto import qualified Cardano.Crypto.Wallet as Crypto.HD import qualified Cardano.Ledger.Api as Ledger import qualified Cardano.Ledger.Keys.Bootstrap as SL +import qualified Cardano.Wallet.Primitive.Convert as Convert import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap import qualified Cardano.Wallet.Shelley.Compatibility as Compatibility -import qualified Cardano.Wallet.Shelley.Compatibility.Ledger as Convert import qualified Data.ByteString as BS import qualified Data.Foldable as F import qualified Data.List as L diff --git a/lib/wallet/test/unit/Internal/Cardano/Write/Tx/BalanceSpec.hs b/lib/wallet/test/unit/Internal/Cardano/Write/Tx/BalanceSpec.hs index 832aea85dee..6dcbd55f3db 100644 --- a/lib/wallet/test/unit/Internal/Cardano/Write/Tx/BalanceSpec.hs +++ b/lib/wallet/test/unit/Internal/Cardano/Write/Tx/BalanceSpec.hs @@ -416,6 +416,7 @@ import qualified Cardano.Slotting.Slot as Slotting import qualified Cardano.Slotting.Time as Slotting import qualified Cardano.Wallet.Address.Derivation.Byron as Byron import qualified Cardano.Wallet.Address.Derivation.Shelley as Shelley +import qualified Cardano.Wallet.Primitive.Convert as Convert import qualified Cardano.Wallet.Primitive.Types as W ( Block (..) , BlockHeader (..) @@ -454,7 +455,6 @@ import qualified Cardano.Wallet.Primitive.Types.Tx.TxOut as W ) import qualified Cardano.Wallet.Primitive.Types.Tx.TxOut.Gen as W import qualified Cardano.Wallet.Primitive.Types.UTxO as W -import qualified Cardano.Wallet.Shelley.Compatibility.Ledger as Convert import qualified Codec.CBOR.Encoding as CBOR import qualified Codec.CBOR.Write as CBOR import qualified Data.ByteString as BS