diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index f64a1ed28c..8a78d64f50 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -131,6 +131,7 @@ library internal Cardano.Api.Query Cardano.Api.Query.Expr Cardano.Api.Query.Types + Cardano.Api.Query.UTxO Cardano.Api.ReexposeConsensus Cardano.Api.ReexposeLedger Cardano.Api.ReexposeNetwork @@ -227,6 +228,7 @@ library internal transformers, transformers-except ^>=0.1.3, typed-protocols ^>=0.1.1, + unordered-containers, vector, yaml, @@ -248,6 +250,7 @@ library Cardano.Api.Ledger Cardano.Api.Network Cardano.Api.Shelley + Cardano.Api.UTxO reexported-modules: Cardano.Api.Ledger.Lens build-depends: diff --git a/cardano-api/internal/Cardano/Api/Convenience/Construction.hs b/cardano-api/internal/Cardano/Api/Convenience/Construction.hs index 081f66eb0b..ec28b16dbb 100644 --- a/cardano-api/internal/Cardano/Api/Convenience/Construction.hs +++ b/cardano-api/internal/Cardano/Api/Convenience/Construction.hs @@ -20,6 +20,7 @@ import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Fees import Cardano.Api.ProtocolParameters import Cardano.Api.Query +import Cardano.Api.Query.UTxO (UTxO (..)) import Cardano.Api.Tx.Body import Cardano.Api.Tx.Sign import Cardano.Api.Utils diff --git a/cardano-api/internal/Cardano/Api/Convenience/Query.hs b/cardano-api/internal/Cardano/Api/Convenience/Query.hs index 8eab5890f6..48df6b8144 100644 --- a/cardano-api/internal/Cardano/Api/Convenience/Query.hs +++ b/cardano-api/internal/Cardano/Api/Convenience/Query.hs @@ -34,6 +34,7 @@ import Cardano.Api.NetworkId import Cardano.Api.ProtocolParameters import Cardano.Api.Query import Cardano.Api.Query.Expr +import Cardano.Api.Query.UTxO (UTxO) import Cardano.Api.Tx.Body import Cardano.Api.Utils diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs index 61a4daf5ba..56a527f796 100644 --- a/cardano-api/internal/Cardano/Api/Fees.hs +++ b/cardano-api/internal/Cardano/Api/Fees.hs @@ -65,6 +65,7 @@ import Cardano.Api.Plutus import Cardano.Api.Pretty import Cardano.Api.ProtocolParameters import Cardano.Api.Query +import Cardano.Api.Query.UTxO (UTxO (..)) import Cardano.Api.Script import Cardano.Api.Tx.Body import Cardano.Api.Tx.Sign diff --git a/cardano-api/internal/Cardano/Api/Query.hs b/cardano-api/internal/Cardano/Api/Query.hs index bfdef390f4..a2ed91721e 100644 --- a/cardano-api/internal/Cardano/Api/Query.hs +++ b/cardano-api/internal/Cardano/Api/Query.hs @@ -22,7 +22,6 @@ module Cardano.Api.Query , QueryInEra (..) , QueryInShelleyBasedEra (..) , QueryUTxOFilter (..) - , UTxO (..) , UTxOInAnyEra (..) -- * Internal conversion functions @@ -77,6 +76,7 @@ import Cardano.Api.Modes import Cardano.Api.NetworkId import Cardano.Api.ProtocolParameters import Cardano.Api.Query.Types +import Cardano.Api.Query.UTxO import qualified Cardano.Api.ReexposeLedger as Ledger import Cardano.Api.Tx.Body @@ -115,10 +115,6 @@ import Ouroboros.Network.NodeToClient.Version (NodeToClientVersion (.. import Ouroboros.Network.Protocol.LocalStateQuery.Client (Some (..)) import Control.Monad.Trans.Except -import Data.Aeson (FromJSON (..), ToJSON (..), withObject) -import qualified Data.Aeson as Aeson -import qualified Data.Aeson.KeyMap as KeyMap -import Data.Aeson.Types (Parser) import Data.Bifunctor (bimap, first) import qualified Data.ByteString.Lazy as LBS import Data.Either.Combinators (rightToMaybe) @@ -363,9 +359,6 @@ instance NodeToClientVersionOf QueryUTxOFilter where newtype ByronUpdateState = ByronUpdateState Byron.Update.State deriving Show -newtype UTxO era = UTxO {unUTxO :: Map TxIn (TxOut CtxUTxO era)} - deriving (Eq, Show) - data UTxOInAnyEra where UTxOInAnyEra :: CardanoEra era @@ -374,25 +367,6 @@ data UTxOInAnyEra where deriving instance Show UTxOInAnyEra -instance IsCardanoEra era => ToJSON (UTxO era) where - toJSON (UTxO m) = toJSON m - toEncoding (UTxO m) = toEncoding m - -instance - (IsShelleyBasedEra era, FromJSON (TxOut CtxUTxO era)) - => FromJSON (UTxO era) - where - parseJSON = withObject "UTxO" $ \hm -> do - let l = toList $ KeyMap.toHashMapText hm - res <- mapM toTxIn l - pure . UTxO $ fromList res - where - toTxIn :: (Text, Aeson.Value) -> Parser (TxIn, TxOut CtxUTxO era) - toTxIn (txinText, txOutVal) = do - (,) - <$> parseJSON (Aeson.String txinText) - <*> parseJSON txOutVal - newtype SerialisedDebugLedgerState era = SerialisedDebugLedgerState (Serialised (Shelley.NewEpochState (ShelleyLedgerEra era))) diff --git a/cardano-api/internal/Cardano/Api/Query/Expr.hs b/cardano-api/internal/Cardano/Api/Query/Expr.hs index f7cf15a16b..a500fae584 100644 --- a/cardano-api/internal/Cardano/Api/Query/Expr.hs +++ b/cardano-api/internal/Cardano/Api/Query/Expr.hs @@ -54,6 +54,7 @@ import Cardano.Api.Keys.Shelley import Cardano.Api.NetworkId import Cardano.Api.ProtocolParameters import Cardano.Api.Query +import Cardano.Api.Query.UTxO (UTxO) import qualified Cardano.Api.ReexposeLedger as Ledger import qualified Cardano.Ledger.Api as L diff --git a/cardano-api/internal/Cardano/Api/Query/UTxO.hs b/cardano-api/internal/Cardano/Api/Query/UTxO.hs new file mode 100644 index 0000000000..bd5a1f9c9a --- /dev/null +++ b/cardano-api/internal/Cardano/Api/Query/UTxO.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UndecidableInstances #-} + +module Cardano.Api.Query.UTxO where + +import Cardano.Api.Eon.ShelleyBasedEra (IsShelleyBasedEra) +import Cardano.Api.Eras.Core (IsCardanoEra) +import Cardano.Api.Tx.Body (CtxUTxO, TxOut (..)) +import Cardano.Api.TxIn (TxIn (..)) + +import Cardano.Ledger.Babbage () + +import Data.Aeson (FromJSON (..), ToJSON (..)) +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.KeyMap as KeyMap +import Data.Aeson.Types (Parser) +import qualified Data.HashMap.Strict as HashMap +import qualified Data.List as List +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Text (Text) +import GHC.IsList (IsList(..)) + +newtype UTxO era = UTxO {unUTxO :: Map TxIn (TxOut CtxUTxO era)} + deriving stock (Eq, Show) + deriving newtype (Semigroup, Monoid, IsList) + +instance IsCardanoEra era => ToJSON (UTxO era) where + toJSON (UTxO m) = toJSON m + toEncoding (UTxO m) = toEncoding m + +instance + IsShelleyBasedEra era + => FromJSON (UTxO era) + where + parseJSON = Aeson.withObject "UTxO" $ \hm -> do + let l = HashMap.toList $ KeyMap.toHashMapText hm + res <- mapM toTxIn l + pure . UTxO $ Map.fromList res + where + toTxIn :: (Text, Aeson.Value) -> Parser (TxIn, TxOut CtxUTxO era) + toTxIn (txinText, txOutVal) = do + (,) + <$> parseJSON (Aeson.String txinText) + <*> parseJSON txOutVal + +-- | Create a 'UTxO from a single unspent transaction output. +singleton :: (TxIn, TxOut CtxUTxO era) -> UTxO era +singleton (i, o) = UTxO $ Map.singleton i o + +-- | Find an 'out' for a given 'TxIn'. +resolve :: TxIn -> UTxO era -> Maybe (TxOut CtxUTxO era) +resolve k = Map.lookup k . unUTxO + +-- | Find first 'UTxO using the output in predicate. +find :: (TxOut CtxUTxO era -> Bool) -> UTxO era -> Maybe (TxIn, TxOut CtxUTxO era) +find fn = findBy (fn . snd) + +-- | Find first 'UTxO using both input and output in predicate. +findBy :: ((TxIn, TxOut CtxUTxO era) -> Bool) -> UTxO era -> Maybe (TxIn, TxOut CtxUTxO era) +findBy fn utxo = List.find fn $ toList utxo + +-- | Filter UTxO to only include 'out's satisfying given predicate. +filter :: (TxOut CtxUTxO era -> Bool) -> UTxO era -> UTxO era +filter fn = UTxO . Map.filter fn . unUTxO + +-- | Get the 'UTxO domain input's set +inputSet :: UTxO (TxOut CtxUTxO era) -> Set TxIn +inputSet = Map.keysSet . unUTxO + +-- | Remove the right hand side from the left hand side. +difference :: UTxO era -> UTxO era -> UTxO era +difference a b = UTxO $ Map.difference (unUTxO a) (unUTxO b) + +-- | Infix version of 'difference'. +(\\) :: UTxO era -> UTxO era -> UTxO era +a \\ b = difference a b diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index dd5078cde1..c96e76904b 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -1110,6 +1110,7 @@ import Cardano.Api.Protocol import Cardano.Api.ProtocolParameters import Cardano.Api.Query hiding (LedgerState (..)) import Cardano.Api.Query.Expr +import Cardano.Api.Query.UTxO (UTxO (..)) import Cardano.Api.Rewards import Cardano.Api.Script import Cardano.Api.ScriptData diff --git a/cardano-api/src/Cardano/Api/UTxO.hs b/cardano-api/src/Cardano/Api/UTxO.hs new file mode 100644 index 0000000000..fe81884c0d --- /dev/null +++ b/cardano-api/src/Cardano/Api/UTxO.hs @@ -0,0 +1,3 @@ +module Cardano.Api.UTxO (module Cardano.Api.Query.UTxO) where + +import Cardano.Api.Query.UTxO