WIP

libs/cardano-debug/src/Cardano/Debug.hs

@@ -132,7 +132,7 @@ friendlyTxBodyContent
 friendlyTxTotalCollateral :: TxTotalCollateral era -> Aeson.Value
 friendlyTxTotalCollateral = \case
   TxTotalCollateralNone -> Null
-  TxTotalCollateral _ lovelace -> friendlyLovelace lovelace
+  TxTotalCollateral _ lovelace -> friendlyCoinLovelace lovelace
 
 friendlyTxReturnCollateral :: (IsCardanoEra era) => TxReturnCollateral CtxTx era -> Aeson.Value
 friendlyTxReturnCollateral = \case
@@ -173,7 +173,7 @@ friendlyWithdrawals (TxWithdrawals _ withdrawals) =
   array
     [ object $
       "address" .= serialiseAddress addr
-        : "amount" .= friendlyLovelace amount
+        : "amount" .= friendlyCoinLovelace amount
         : friendlyStakeAddress addr
     | (addr, amount, _) <- withdrawals
     ]
@@ -205,7 +205,7 @@ friendlyTxOut (TxOut addr amount mdatum script) =
                   ]
             datum =
               [ "datum" .= renderDatum mdatum
-              | isJust $ inEonForEraMaybe @AlonzoEraOnwards id $ shelleyBasedToCardanoEra sbe
+              | isJust $ inEonForEraMaybe @AlonzoEraOnwards id $ toCardanoEra sbe
               ]
             sinceAlonzo = ["reference script" .= script]
          in preAlonzo ++ datum ++ sinceAlonzo
@@ -281,12 +281,12 @@ friendlyProtocolParametersUpdate
       , protocolUpdateMaxTxSize <&> ("max transaction size" .=)
       , protocolUpdateTxFeeFixed <&> ("transaction fee constant" .=)
       , protocolUpdateTxFeePerByte <&> ("transaction fee linear per byte" .=)
-      , protocolUpdateMinUTxOValue <&> ("min UTxO value" .=) . friendlyLovelace
+      , protocolUpdateMinUTxOValue <&> ("min UTxO value" .=) . friendlyCoinLovelace
       , protocolUpdateStakeAddressDeposit
-          <&> ("key registration deposit" .=) . friendlyLovelace
+          <&> ("key registration deposit" .=) . friendlyCoinLovelace
       , protocolUpdateStakePoolDeposit
-          <&> ("pool registration deposit" .=) . friendlyLovelace
-      , protocolUpdateMinPoolCost <&> ("min pool cost" .=) . friendlyLovelace
+          <&> ("pool registration deposit" .=) . friendlyCoinLovelace
+      , protocolUpdateMinPoolCost <&> ("min pool cost" .=) . friendlyCoinLovelace
       , protocolUpdatePoolRetireMaxEpoch <&> ("pool retirement epoch boundary" .=)
       , protocolUpdateStakePoolTargetNum <&> ("number of pools" .=)
       , protocolUpdatePoolPledgeInfluence
@@ -302,7 +302,7 @@ friendlyProtocolParametersUpdate
       , protocolUpdateMaxValueSize <&> ("max value size" .=)
       , protocolUpdatePrices <&> ("execution prices" .=) . friendlyPrices
       , protocolUpdateUTxOCostPerByte
-          <&> ("UTxO storage cost per byte" .=) . friendlyLovelace
+          <&> ("UTxO storage cost per byte" .=) . friendlyCoinLovelace
       ]
 
 friendlyPrices :: ExecutionUnitPrices -> Aeson.Value
@@ -356,11 +356,11 @@ friendlyMirTarget = \case
     "target stake addresses"
       .= [ object
           [ friendlyStakeCredential credential
-          , "amount" .= friendlyCoin (Coin.addDeltaCoin (Coin.Coin 0) lovelace)
+          , "amount" .= friendlyCoinLovelace (Coin.addDeltaCoin (Coin.Coin 0) lovelace)
           ]
          | (credential, lovelace) <- Map.toList addresses
          ]
-  SendToOppositePotMIR amount -> "send to reserves" .= friendlyCoin amount
+  SendToOppositePotMIR amount -> "send to reserves" .= friendlyCoinLovelace amount
 
 friendlyStakeCredential :: (Crypto.Crypto era) => Shelley.Credential 'Shelley.Staking era -> Aeson.Pair
 friendlyStakeCredential = \case
@@ -397,10 +397,10 @@ friendlyStakePoolParameters
     object
       [ "pool" .= stakePoolId
       , "VRF key hash" .= serialiseToRawBytesHexText stakePoolVRF
-      , "cost" .= friendlyLovelace stakePoolCost
+      , "cost" .= friendlyCoinLovelace stakePoolCost
       , "margin" .= friendlyRational stakePoolMargin
       , "reward account" .= object (friendlyStakeAddress stakePoolRewardAccount)
-      , "pledge" .= friendlyLovelace stakePoolPledge
+      , "pledge" .= friendlyCoinLovelace stakePoolPledge
       , "owners (stake key hashes)"
           .= map serialiseToRawBytesHexText stakePoolOwners
       , "relays" .= map textShow stakePoolRelays
@@ -419,13 +419,10 @@ friendlyRational r =
 
 friendlyFee :: TxFee era -> Aeson.Value
 friendlyFee = \case
-  TxFeeExplicit _ fee -> friendlyLovelace fee
+  TxFeeExplicit _ fee -> friendlyCoinLovelace fee
 
-friendlyCoin :: Coin.Coin -> Aeson.Value
-friendlyCoin (Coin.Coin value) = String $ textShow value <> " Lovelace"
-
-friendlyLovelace :: Lovelace -> Aeson.Value
-friendlyLovelace (Lovelace value) = String $ textShow value <> " Lovelace"
+friendlyCoinLovelace :: Coin.Coin -> Aeson.Value
+friendlyCoinLovelace (Coin.Coin value) = String $ textShow value <> " Lovelace"
 
 friendlyMintValue :: forall era view. TxMintValue view era -> Aeson.Value
 friendlyMintValue = \case
@@ -434,7 +431,7 @@ friendlyMintValue = \case
 
 friendlyTxOutValue :: TxOutValue era -> Aeson.Value
 friendlyTxOutValue = \case
-  TxOutValueByron lovelace -> friendlyLovelace lovelace
+  TxOutValueByron lovelace -> friendlyCoinLovelace lovelace
   TxOutValueShelleyBased era v -> friendlyValue $ fromLedgerValue era v
 
 friendlyValue :: Api.Value -> Aeson.Value

libs/plutus-ledger-aeson/src/Plutus/V1/Ledger/Aeson.hs

@@ -30,6 +30,7 @@ import PlutusLedgerApi.V1.Bytes qualified as Bytes
 import PlutusLedgerApi.V1.Scripts
 import PlutusLedgerApi.V1.Tx
 import PlutusLedgerApi.V1.Value
+import PlutusTx.Eq qualified as PlutusTx
 
 deriving anyclass instance ToJSON DatumHash
 deriving anyclass instance FromJSON DatumHash
@@ -138,10 +139,10 @@ deriving newtype instance Serialise Value
 instance (ToJSON v, ToJSON k) => ToJSON (Map.Map k v) where
   toJSON = JSON.toJSON . Map.toList
 
-instance (FromJSON v, FromJSON k) => FromJSON (Map.Map k v) where
-  parseJSON v = Map.fromList <$> JSON.parseJSON v
+instance (PlutusTx.Eq k, FromJSON v, FromJSON k) => FromJSON (Map.Map k v) where
+  parseJSON v = Map.safeFromList <$> JSON.parseJSON v
 
-deriving anyclass instance (Hashable k, Hashable v) => Hashable (Map.Map k v)
+deriving anyclass instance (Ord k, Hashable k, Hashable v) => Hashable (Map.Map k v)
 deriving anyclass instance (Serialise k, Serialise v) => Serialise (Map.Map k v)
 
 -- | Custom `FromJSON` instance which allows to parse a JSON number to a

marlowe-chain-sync/src/Language/Marlowe/Runtime/Cardano/Feature.hs

@@ -35,7 +35,7 @@ class CardanoFeature f where
 
 class (CardanoFeature f) => ShelleyFeature f where
   featureInShelleyBasedEra :: ShelleyBasedEra era -> Maybe (f era)
-  featureInShelleyBasedEra = featureInCardanoEra . shelleyBasedToCardanoEra
+  featureInShelleyBasedEra = featureInCardanoEra . toCardanoEra
   shelleyBasedEraOfFeature :: f era -> ShelleyBasedEra era
 
 instance CardanoFeature CardanoEra where
@@ -51,7 +51,7 @@ instance CardanoFeature ShelleyBasedEra where
     AlonzoEra -> Just ShelleyBasedEraAlonzo
     BabbageEra -> Just ShelleyBasedEraBabbage
     ConwayEra -> Just ShelleyBasedEraConway
-  cardanoEraOfFeature = shelleyBasedToCardanoEra
+  cardanoEraOfFeature = toCardanoEra
 
 instance ShelleyFeature ShelleyBasedEra where
   featureInShelleyBasedEra = Just

marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Api.hs

@@ -39,7 +39,9 @@ import Cardano.Api (
  )
 import qualified Cardano.Api as C
 import qualified Cardano.Api as Cardano
-import Cardano.Api.Shelley (ProtocolParameters, fromShelleyBasedScript, toShelleyScript)
+import qualified Cardano.Api.Ledger as Coin
+import Cardano.Api.ProtocolParameters
+import Cardano.Api.Shelley (fromShelleyBasedScript, toShelleyScript)
 import qualified Cardano.Api.Shelley as Cardano
 import qualified Cardano.Ledger.BaseTypes as Base
 import qualified Cardano.Ledger.BaseTypes as C
@@ -138,7 +140,7 @@ import qualified Network.Protocol.Query.Types as Query
 import Observe.Event.Render.OpenTelemetry (RenderSelectorOTel)
 import OpenTelemetry.Attributes (Attribute, PrimitiveAttribute (..))
 import OpenTelemetry.Trace.Core (toAttribute)
-import Ouroboros.Consensus.Block (EpochNo (..), EpochSize (..))
+import Ouroboros.Consensus.Block (EpochNo (..), EpochSize (..), GenesisWindow)
 import qualified Ouroboros.Consensus.Block as O
 import Ouroboros.Consensus.BlockchainTime (RelativeTime, SlotLength (..), SystemStart (..))
 import Ouroboros.Consensus.HardFork.History (
@@ -151,7 +153,7 @@ import Ouroboros.Consensus.HardFork.History (
   Summary (Summary),
   mkInterpreter,
  )
-import PlutusCore.Evaluation.Machine.ExBudgetingDefaults (defaultCostModelParams)
+import PlutusCore.Evaluation.Machine.ExBudgetingDefaults (defaultCostModelParamsForTesting)
 import qualified PlutusLedgerApi.V1 as Plutus
 import Text.Read (readMaybe)
 import Unsafe.Coerce (unsafeCoerce)
@@ -1215,7 +1217,8 @@ renderChainSyncQueryOTel = \case
       { requestName = "get-protocol-parameters"
       , requestAttributes = []
       , responseAttributes = \params ->
-          [("protocol-parameters", toAttribute $ TextAttribute $ TL.toStrict $ encodeToLazyText params)]
+          [ ("protocol-parameters", toAttribute $ TextAttribute $ TL.toStrict $ encodeToLazyText params)
+          ]
       }
   GetSystemStart ->
     RequestRenderedOTel
@@ -1745,8 +1748,8 @@ instance Variations ProtocolParameters
 instance Variations C.PraosNonce where
   variations = C.makePraosNonce <$> variations
 
-instance Variations C.Lovelace where
-  variations = C.Lovelace <$> variations
+instance Variations Coin.Coin where
+  variations = Coin.Coin <$> variations
 
 instance Variations C.EpochNo
 
@@ -1757,10 +1760,11 @@ instance Variations C.AnyPlutusScriptVersion where
     NE.fromList
       [ C.AnyPlutusScriptVersion C.PlutusScriptV1
       , C.AnyPlutusScriptVersion C.PlutusScriptV2
+      , C.AnyPlutusScriptVersion C.PlutusScriptV3
       ]
 
 instance Variations C.CostModel where
-  variations = pure $ C.CostModel $ Map.elems $ fromJust defaultCostModelParams
+  variations = pure $ C.CostModel $ Map.elems $ fromJust defaultCostModelParamsForTesting
 
 instance Variations C.ExecutionUnitPrices where
   variations = C.ExecutionUnitPrices <$> variations `varyAp` variations
@@ -1787,6 +1791,10 @@ instance Variations EraSummary
 
 instance Variations EraParams
 
+instance Variations GenesisWindow
+
+deriving instance (Generic GenesisWindow)
+
 instance Variations SafeZone
 
 instance Variations EpochSize

marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Common.hs

@@ -299,7 +299,7 @@ balanceTx era (Wallet WalletAddresses{..} _) utxo txBodyContent = do
   history <- queryNode 0 C.QueryEraHistory
   protocol <- queryShelley 0 $ C.QueryInShelleyBasedEra era C.QueryProtocolParameters
   changeAddr <-
-    expectJust "Could not convert to Cardano address" $ toCardanoAddressInEra (C.shelleyBasedToCardanoEra era) changeAddress
+    expectJust "Could not convert to Cardano address" $ toCardanoAddressInEra (C.toCardanoEra era) changeAddress
   C.BalancedTxBody _ txBody _ _ <-
     withShelleyBasedEra era $
       expectRight "Failed to balance Tx" $

marlowe/src/Language/Marlowe/Core/V1/Semantics/Types.hs

@@ -522,8 +522,8 @@ toJSONAssocMap :: (ToJSON k) => (ToJSON v) => Map k v -> JSON.Value
 toJSONAssocMap = toJSON . Map.toList
 
 -- | Parse an association list from JSON.
-fromJSONAssocMap :: (FromJSON k) => (FromJSON v) => JSON.Value -> JSON.Parser (Map k v)
-fromJSONAssocMap v = Map.fromList <$> parseJSON v
+fromJSONAssocMap :: (Eq k) => (FromJSON k) => (FromJSON v) => JSON.Value -> JSON.Parser (Map k v)
+fromJSONAssocMap v = Map.safeFromList <$> parseJSON v
 
 instance FromJSON Party where
   parseJSON = withObject "Party" $ \v ->