From c3ff87d62dcf4b72c9a21910af49e6e556bedf30 Mon Sep 17 00:00:00 2001 From: Konstantinos Lambrou-Latreille Date: Thu, 14 Nov 2024 14:17:51 -0500 Subject: [PATCH] Make Conway era specific function more general * Changed unTransAddressInEra, transAddressInEra, unTransTxOutValue, unTransTxOutDatumHash --- src/base/lib/Convex/PlutusLedger.hs | 25 +++++++++++++++--------- src/base/test/Convex/PlutusLedgerSpec.hs | 17 ++++++++-------- 2 files changed, 25 insertions(+), 17 deletions(-) diff --git a/src/base/lib/Convex/PlutusLedger.hs b/src/base/lib/Convex/PlutusLedger.hs index 12012dc5..5d5ba980 100644 --- a/src/base/lib/Convex/PlutusLedger.hs +++ b/src/base/lib/Convex/PlutusLedger.hs @@ -68,6 +68,7 @@ module Convex.PlutusLedger( ) where +import qualified Cardano.Api.Ledger as Ledger import qualified Cardano.Api.Shelley as C import Cardano.Ledger.BaseTypes (CertIx (..), TxIx (..)) import Cardano.Ledger.Credential (Ptr (..)) @@ -115,7 +116,7 @@ transAssetId :: C.AssetId -> Value.AssetClass transAssetId C.AdaAssetId = Value.assetClass PV1.adaSymbol PV1.adaToken transAssetId (C.AssetId policyId assetName) = Value.assetClass - (transPolicyId $ policyId) + (transPolicyId policyId) (transAssetName $ toMaryAssetName assetName) toMaryAssetName :: C.AssetName -> Mary.AssetName @@ -185,16 +186,16 @@ unTransStakeAddressReference (Just (PV1.StakingHash credential)) = unTransStakeAddressReference (Just (PV1.StakingPtr slotNo txIx ptrIx)) = Right (C.StakeAddressByPointer (C.StakeAddressPointer (Ptr (C.SlotNo $ fromIntegral slotNo) (TxIx $ fromIntegral txIx) (CertIx $ fromIntegral ptrIx)))) -unTransAddressInEra :: C.NetworkId -> PV1.Address -> Either C.SerialiseAsRawBytesError (C.AddressInEra C.ConwayEra) +unTransAddressInEra :: C.IsShelleyBasedEra era => C.NetworkId -> PV1.Address -> Either C.SerialiseAsRawBytesError (C.AddressInEra era) unTransAddressInEra networkId addr = - C.AddressInEra (C.ShelleyAddressInEra C.ShelleyBasedEraConway) <$> + C.AddressInEra (C.ShelleyAddressInEra C.shelleyBasedEra) <$> unTransAddressShelley networkId addr -- | @cardano-api@ address to @plutus@ address. Returns 'Nothing' for -- | byron addresses. -transAddressInEra :: C.AddressInEra C.ConwayEra -> Maybe PV1.Address +transAddressInEra :: C.AddressInEra era -> Maybe PV1.Address transAddressInEra = \case - C.AddressInEra (C.ShelleyAddressInEra C.ShelleyBasedEraConway) shelleyAddr -> + C.AddressInEra (C.ShelleyAddressInEra _) shelleyAddr -> Just $ transAddressShelley shelleyAddr C.AddressInEra C.ByronAddressInAnyEra _ -> Nothing @@ -227,8 +228,14 @@ transPOSIXTime posixTimeSeconds = PV1.POSIXTime (floor @Rational (1000 * realToF unTransPOSIXTime :: PV1.POSIXTime -> POSIXTime unTransPOSIXTime (PV1.POSIXTime pt) = realToFrac @Rational $ fromIntegral pt / 1000 -unTransTxOutValue :: PV1.Value -> Either C.SerialiseAsRawBytesError (C.TxOutValue C.ConwayEra) -unTransTxOutValue value = C.TxOutValueShelleyBased C.ShelleyBasedEraConway . C.toMaryValue <$> unTransValue value +unTransTxOutValue :: forall era. + ( C.IsBabbageBasedEra era + , Eq (Ledger.Value (C.ShelleyLedgerEra era)) + , Show (Ledger.Value (C.ShelleyLedgerEra era)) + ) + => PV1.Value + -> Either C.SerialiseAsRawBytesError (C.TxOutValue era) +unTransTxOutValue value = C.TxOutValueShelleyBased C.shelleyBasedEra . C.toLedgerValue @era C.maryBasedEra <$> unTransValue value unTransValue :: PV1.Value -> Either C.SerialiseAsRawBytesError C.Value unTransValue = @@ -256,5 +263,5 @@ unTransScriptDataHash :: P.DatumHash -> Either C.SerialiseAsRawBytesError (C.Has unTransScriptDataHash (P.DatumHash bs) = C.deserialiseFromRawBytes (C.AsHash C.AsScriptData) (PlutusTx.fromBuiltin bs) -unTransTxOutDatumHash :: P.DatumHash -> Either C.SerialiseAsRawBytesError (C.TxOutDatum ctx C.ConwayEra) -unTransTxOutDatumHash datumHash = C.TxOutDatumHash C.AlonzoEraOnwardsConway <$> unTransScriptDataHash datumHash +unTransTxOutDatumHash :: C.IsAlonzoBasedEra era => P.DatumHash -> Either C.SerialiseAsRawBytesError (C.TxOutDatum ctx era) +unTransTxOutDatumHash datumHash = C.TxOutDatumHash C.alonzoBasedEra <$> unTransScriptDataHash datumHash diff --git a/src/base/test/Convex/PlutusLedgerSpec.hs b/src/base/test/Convex/PlutusLedgerSpec.hs index 4b594715..3b71bb1c 100644 --- a/src/base/test/Convex/PlutusLedgerSpec.hs +++ b/src/base/test/Convex/PlutusLedgerSpec.hs @@ -1,14 +1,15 @@ {-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE GADTs #-} +{-# LANGUAGE GADTs #-} module Convex.PlutusLedgerSpec where -import qualified Cardano.Api.Shelley as C -import Test.Gen.Cardano.Api.Typed qualified as CGen -import Convex.PlutusLedger (transAddressShelley, unTransAddressShelley) -import Test.QuickCheck qualified as QC -import Test.QuickCheck.Hedgehog qualified as QC -import qualified Cardano.Api.Ledger as Shelley +import qualified Cardano.Api.Ledger as Shelley +import qualified Cardano.Api.Shelley as C +import Convex.PlutusLedger (transAddressShelley, + unTransAddressShelley) +import qualified Test.Gen.Cardano.Api.Typed as CGen +import qualified Test.QuickCheck as QC +import qualified Test.QuickCheck.Hedgehog as QC newtype ArbitraryNetworkMagic = ArbitraryNetworkMagic C.NetworkMagic deriving stock (Show) @@ -29,5 +30,5 @@ prop_rountripAddressShelleyPlutusTranslation = do let nid = case n of Shelley.Mainnet -> C.Mainnet; Shelley.Testnet -> C.Testnet nm case unTransAddressShelley nid (transAddressShelley addr) of - Left _err -> False + Left _err -> False Right addr' -> addr' == addr