diff --git a/eras/alonzo/impl/CHANGELOG.md b/eras/alonzo/impl/CHANGELOG.md index c20d6bc78cc..352684e3dbb 100644 --- a/eras/alonzo/impl/CHANGELOG.md +++ b/eras/alonzo/impl/CHANGELOG.md @@ -3,6 +3,7 @@ ## 1.16.0.0 * Add `ToJSON` and `FromJSON` instances for `AlonzoTxAuxData era` +* Add `FromJSON` instance for `AlonzoTxOut era` * Add `FromJSON` instance for `AsIx ix it` * Add `FromJSON` instance for `AlonzoPlutusPurpose AsIx era` * Add `ToJSON` and `FromJSON` instances for `TxDats era`, `Redeemers era`, and `AlonzoTxWits era` diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxOut.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxOut.hs index 4542bde2425..9ff0cc2a2d5 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxOut.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxOut.hs @@ -77,8 +77,8 @@ import qualified Cardano.Ledger.Shelley.TxOut as Shelley import Cardano.Ledger.Val (Val (..)) import Control.DeepSeq (NFData (..), rwhnf) import Control.Monad (guard) -import Data.Aeson (ToJSON (..), object, (.=)) -import qualified Data.Aeson as Aeson (Value (Null, String)) +import Data.Aeson (FromJSON (..), ToJSON (..), object, (.:), (.=)) +import qualified Data.Aeson as Aeson import Data.Bits import Data.Maybe (fromMaybe) import Data.MemPack @@ -445,6 +445,13 @@ instance (Era era, Val (Value era)) => ToJSON (AlonzoTxOut era) where extractHash dHash ] +instance (Era era, Val (Value era)) => FromJSON (AlonzoTxOut era) where + parseJSON = Aeson.withObject "AlonzoTxOut" $ \o -> + AlonzoTxOut + <$> o .: "address" + <*> o .: "value" + <*> o .: "datahash" + pattern TxOutCompact :: (Era era, Val (Value era), HasCallStack) => CompactAddr -> diff --git a/eras/babbage/impl/CHANGELOG.md b/eras/babbage/impl/CHANGELOG.md index 11bc748f261..4e2ee86b813 100644 --- a/eras/babbage/impl/CHANGELOG.md +++ b/eras/babbage/impl/CHANGELOG.md @@ -2,6 +2,7 @@ ## 1.14.0.0 +* Add `FromJSON` instance for `BabbageTxOut era` * Replace arguments of `babbageEvalScriptsTxInvalid` with `StAnnTx` * Replace arguments of `expectScriptsToPass` with `StAnnTx` * Change `Signal` to `StAnnTx TopTx era` for: `BabbageLEDGER`, `BabbageUTXOW`, `BabbageUTXO`, `BabbageUTXOS` diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxOut.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxOut.hs index f910b8f9f9d..7a0d12ea844 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxOut.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxOut.hs @@ -111,7 +111,8 @@ import Cardano.Ledger.Plutus.Data ( ) import Cardano.Ledger.Val (Val (..)) import Control.DeepSeq (NFData (rnf), rwhnf) -import Data.Aeson (ToJSON (..), (.=)) +import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.=)) +import qualified Data.Aeson as Aeson import qualified Data.ByteString.Lazy as LBS import Data.Maybe (fromMaybe) import Data.MemPack @@ -335,6 +336,14 @@ instance (Era era, Val (Value era), ToJSON (Script era)) => ToKeyValuePairs (Bab , "referenceScript" .= mRefScript ] +instance (Era era, Val (Value era), FromJSON (Script era)) => FromJSON (BabbageTxOut era) where + parseJSON = Aeson.withObject "BabbageTxOut" $ \o -> + BabbageTxOut + <$> o .: "address" + <*> o .: "value" + <*> o .: "datum" + <*> o .: "referenceScript" + viewCompactTxOut :: forall era. Val (Value era) => diff --git a/eras/mary/impl/CHANGELOG.md b/eras/mary/impl/CHANGELOG.md index 55fce69bc69..456a80feb12 100644 --- a/eras/mary/impl/CHANGELOG.md +++ b/eras/mary/impl/CHANGELOG.md @@ -2,6 +2,8 @@ ## 1.11.0.0 +* Add `FromJSON` instance for `MaryValue` +* Add `FromJSON` and `FromJSONKey` instances for `AssetName` (hex-decoding from `ToJSON` format) * Add `ApplyTick` instance for `MaryEra` * Add `EraForecast` and `ShelleyEraForecast` instances for `MaryEra`. diff --git a/eras/mary/impl/src/Cardano/Ledger/Mary/Value.hs b/eras/mary/impl/src/Cardano/Ledger/Mary/Value.hs index 86519416434..9bdc58e192d 100644 --- a/eras/mary/impl/src/Cardano/Ledger/Mary/Value.hs +++ b/eras/mary/impl/src/Cardano/Ledger/Mary/Value.hs @@ -68,7 +68,7 @@ import Control.DeepSeq (NFData (..), deepseq, rwhnf) import Control.Exception (assert) import Control.Monad (forM_, guard, unless, when) import Control.Monad.ST (runST) -import Data.Aeson (FromJSON, FromJSONKey, ToJSON (..), (.=)) +import Data.Aeson (FromJSON, FromJSONKey (..), ToJSON (..), (.:), (.=)) import qualified Data.Aeson as Aeson import Data.Aeson.Types (ToJSONKey (..), toJSONKeyText) import qualified Data.ByteString as BS @@ -98,7 +98,7 @@ import qualified Data.Semigroup as Semigroup (Sum (..)) import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) -import Data.Text.Encoding (decodeLatin1) +import Data.Text.Encoding (decodeLatin1, encodeUtf8) import Data.Word (Word16, Word32, Word64) import GHC.Generics (Generic) import NoThunks.Class (NoThunks (..), OnlyCheckWhnfNamed (..)) @@ -123,6 +123,10 @@ assetNameToBytesAsHex = BS16.encode . SBS.fromShort . assetNameBytes assetNameToTextAsHex :: AssetName -> Text assetNameToTextAsHex = decodeLatin1 . assetNameToBytesAsHex +assetNameFromText :: Text -> Either String AssetName +assetNameFromText t = + AssetName . SBS.toShort <$> BS16.decode (encodeUtf8 t) + instance DecCBOR AssetName where decCBOR = do an <- decCBOR @@ -153,7 +157,7 @@ newtype PolicyID = PolicyID {policyID :: ScriptHash} -- | The MultiAssets map newtype MultiAsset = MultiAsset (Map PolicyID (Map AssetName Integer)) - deriving (Show, Generic, ToJSON, EncCBOR) + deriving (Show, Generic, FromJSON, ToJSON, EncCBOR) instance Eq MultiAsset where MultiAsset x == MultiAsset y = pointWise (pointWise (==)) x y @@ -383,6 +387,12 @@ decodeIntegerBounded64 = do -- ======================================================================== -- JSON +instance FromJSON MaryValue where + parseJSON = Aeson.withObject "MaryValue" $ \o -> + MaryValue + <$> o .: "lovelace" + <*> o .: "policies" + instance ToKeyValuePairs MaryValue where toKeyValuePairs (MaryValue l ps) = [ "lovelace" .= l @@ -395,6 +405,18 @@ instance ToJSON AssetName where instance ToJSONKey AssetName where toJSONKey = toJSONKeyText assetNameToTextAsHex +instance FromJSON AssetName where + parseJSON = Aeson.withText "AssetName" $ \t -> + case assetNameFromText t of + Left e -> fail $ "AssetName: invalid hex: " <> e + Right bs -> pure bs + +instance FromJSONKey AssetName where + fromJSONKey = Aeson.FromJSONKeyTextParser $ \t -> + case assetNameFromText t of + Left e -> fail $ "AssetName: invalid hex: " <> e + Right bs -> pure bs + -- ======================================================================== -- Compactible -- This is used in the TxOut which stores the (CompactForm MaryValue). diff --git a/eras/shelley/impl/CHANGELOG.md b/eras/shelley/impl/CHANGELOG.md index 55d946b567d..5942b438a90 100644 --- a/eras/shelley/impl/CHANGELOG.md +++ b/eras/shelley/impl/CHANGELOG.md @@ -3,6 +3,7 @@ ## 1.19.0.0 * Add `ToJSON` and `FromJSON` instances for `ShelleyTxAuxData era` +* Add `FromJSON` instance for `ShelleyTxOut era` * Add `ToJSON` and `FromJSON` instances for `ShelleyTxWits era` * Change `NoThunks` instance for `BlockTransitionError` to not check for thunks in its contents * Add `NFData` constraint to `BlockTransitionError` constructor. diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxOut.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxOut.hs index b0932c85999..4d040fed2dc 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxOut.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxOut.hs @@ -45,7 +45,8 @@ import Cardano.Ledger.Shelley.Era (ShelleyEra) import Cardano.Ledger.Shelley.PParams () import Cardano.Ledger.Val (Val) import Control.DeepSeq (NFData (rnf)) -import Data.Aeson (ToJSON (..), (.=)) +import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.=)) +import qualified Data.Aeson as Aeson import Data.Maybe (fromMaybe) import Data.MemPack import GHC.Generics (Generic) @@ -183,3 +184,9 @@ instance (Era era, Val (Value era)) => ToKeyValuePairs (ShelleyTxOut era) where [ "address" .= addr , "amount" .= amount ] + +instance (Era era, Val (Value era)) => FromJSON (ShelleyTxOut era) where + parseJSON = Aeson.withObject "ShelleyTxOut" $ \o -> + ShelleyTxOut + <$> o .: "address" + <*> o .: "amount" diff --git a/libs/cardano-ledger-core/CHANGELOG.md b/libs/cardano-ledger-core/CHANGELOG.md index ffcc03c3d1f..e3034f693e0 100644 --- a/libs/cardano-ledger-core/CHANGELOG.md +++ b/libs/cardano-ledger-core/CHANGELOG.md @@ -34,6 +34,9 @@ * Rename `kindObject` (which returned `Value`) to `kindObjectValue` * Add `kindObject :: Text -> [Pair] -> Object` returning an `Aeson.Object` * Add `NFData (Script era)`, `ToJSON (Script era)`, `FromJSON (Script era)`, `ToJSON (NativeScript era)`, and `FromJSON (NativeScript era)` as superclass constraints to `EraScript` +* Add `FromJSON (TxOut era)` as `EraTxOut` superclass constraint +* Add `FromJSON t` as `Val t` superclass constraint +* Add `ToJSON` and `FromJSON` instances for `Datum era` * Add `ToJSON`, `FromJSON` and `NFData` as `EraTxWits` superclass constraints * Add `ToJSONKey` and `FromJSONKey` instances to `AccountId` * Add `ToJSON` and `FromJSON` instances for `Inclusive a` and `Exclusive a` @@ -64,6 +67,7 @@ * Add round-trip JSON property test for `NativeScript era` and `Script era` to the shared era spec * Add round-trip JSON property test for `TxAuxData era` to the shared era spec * Add round-trip JSON property test for `TxWits era` to the shared era spec +* Add round-trip JSON property test for `TxOut era` to the shared era spec ## 1.20.0.0 diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Core.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Core.hs index 1d30aa216e7..f43522b65fa 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Core.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Core.hs @@ -291,6 +291,7 @@ class -- | Abstract interface into specific fields of a `TxOut` class ( Val (Value era) + , FromJSON (TxOut era) , ToJSON (TxOut era) , DecCBOR (Value era) , DecCBOR (CompactForm (Value era)) diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/Data.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/Data.hs index 8d850a1d52e..083113a8969 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/Data.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/Data.hs @@ -65,7 +65,7 @@ import Cardano.Ledger.MemoBytes ( ) import Cardano.Ledger.MemoBytes.Internal (mkMemoBytesShort) import qualified Codec.Serialise as Cborg (Serialise (..)) -import Control.Applicative (asum) +import Control.Applicative (asum, (<|>)) import Control.DeepSeq (NFData) import Control.Monad ((<$!>)) import Data.Aeson (FromJSON (..), ToJSON (..), Value (Null), object, withObject, (.:), (.=)) @@ -306,14 +306,15 @@ instance Era era => DecCBOR (Datum era) where decodeDatum k = Invalid k instance Era era => ToJSON (Datum era) where - toJSON d = - case datumDataHash d of - SNothing -> Null - SJust dh -> toJSON dh - toEncoding d = - case datumDataHash d of - SNothing -> toEncoding Null - SJust dh -> toEncoding dh + toJSON NoDatum = Null + toJSON (DatumHash dh) = object ["datumhash" .= dh] + toJSON (Datum bd) = object ["datum" .= binaryDataToData @era bd] + +instance Era era => FromJSON (Datum era) where + parseJSON Null = pure NoDatum + parseJSON v = + withObject "DatumHash" (\o -> DatumHash <$> o .: "datumhash") v + <|> withObject "Datum" (\o -> Datum . dataToBinaryData <$> o .: "datum") v mkInlineDatum :: forall era. Era era => PV1.Data -> Datum era mkInlineDatum = Datum . dataToBinaryData . Data @era diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Val.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Val.hs index f85f05f03b9..5d0a9c2e06e 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Val.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Val.hs @@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} -- | This module defines a generalised notion of a "value" - that is, something @@ -21,7 +20,7 @@ import Cardano.Ledger.Binary (DecCBOR, EncCBOR) import Cardano.Ledger.Coin (Coin (..), CompactForm (..), DeltaCoin (..)) import Cardano.Ledger.Compactible (Compactible (..)) import Control.DeepSeq (NFData) -import Data.Aeson (ToJSON) +import Data.Aeson (FromJSON, ToJSON) import Data.Coerce import Data.Foldable as F (foldl') import Data.Group (Abelian) @@ -36,6 +35,7 @@ class , NoThunks t , EncCBOR t , DecCBOR t + , FromJSON t , ToJSON t , NFData t , Show t diff --git a/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Era.hs b/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Era.hs index 376c4df319e..36e530c1df5 100644 --- a/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Era.hs +++ b/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Era.hs @@ -176,6 +176,8 @@ ledgerEraTestMain extraEraSpec = roundTripAesonProperty @(TxAuxData era) prop (show $ typeRep $ Proxy @(TxWits era)) $ roundTripAesonProperty @(TxWits era) + prop (show $ typeRep $ Proxy @(TxOut era)) $ + roundTripAesonProperty @(TxOut era) describe "Era-specific spec" extraEraSpec -- | This is a helper function that uses `mkTestAccountState` to register an account.