{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Api.Internal.Tx.UTxO where

import Cardano.Api.Internal.Eon.ShelleyBasedEra (IsShelleyBasedEra)
import Cardano.Api.Internal.Eras.Core (IsCardanoEra)
import Cardano.Api.Internal.Tx.Body (CtxUTxO, TxOut (..))
import Cardano.Api.Internal.TxIn (TxIn (..))

import Cardano.Ledger.Babbage ()

import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Aeson qualified as Aeson
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Aeson.Types (Parser)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Set (Set)
import Data.Text (Text)
import GHC.Exts (IsList (..))

newtype UTxO era = UTxO {forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
unUTxO :: Map TxIn (TxOut CtxUTxO era)}
  deriving stock (UTxO era -> UTxO era -> Bool
(UTxO era -> UTxO era -> Bool)
-> (UTxO era -> UTxO era -> Bool) -> Eq (UTxO era)
forall era. UTxO era -> UTxO era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era. UTxO era -> UTxO era -> Bool
== :: UTxO era -> UTxO era -> Bool
$c/= :: forall era. UTxO era -> UTxO era -> Bool
/= :: UTxO era -> UTxO era -> Bool
Eq, Int -> UTxO era -> ShowS
[UTxO era] -> ShowS
UTxO era -> String
(Int -> UTxO era -> ShowS)
-> (UTxO era -> String) -> ([UTxO era] -> ShowS) -> Show (UTxO era)
forall era. Int -> UTxO era -> ShowS
forall era. [UTxO era] -> ShowS
forall era. UTxO era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> UTxO era -> ShowS
showsPrec :: Int -> UTxO era -> ShowS
$cshow :: forall era. UTxO era -> String
show :: UTxO era -> String
$cshowList :: forall era. [UTxO era] -> ShowS
showList :: [UTxO era] -> ShowS
Show)
  deriving newtype (NonEmpty (UTxO era) -> UTxO era
UTxO era -> UTxO era -> UTxO era
(UTxO era -> UTxO era -> UTxO era)
-> (NonEmpty (UTxO era) -> UTxO era)
-> (forall b. Integral b => b -> UTxO era -> UTxO era)
-> Semigroup (UTxO era)
forall b. Integral b => b -> UTxO era -> UTxO era
forall era. NonEmpty (UTxO era) -> UTxO era
forall era. UTxO era -> UTxO era -> UTxO era
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall era b. Integral b => b -> UTxO era -> UTxO era
$c<> :: forall era. UTxO era -> UTxO era -> UTxO era
<> :: UTxO era -> UTxO era -> UTxO era
$csconcat :: forall era. NonEmpty (UTxO era) -> UTxO era
sconcat :: NonEmpty (UTxO era) -> UTxO era
$cstimes :: forall era b. Integral b => b -> UTxO era -> UTxO era
stimes :: forall b. Integral b => b -> UTxO era -> UTxO era
Semigroup, Semigroup (UTxO era)
UTxO era
Semigroup (UTxO era) =>
UTxO era
-> (UTxO era -> UTxO era -> UTxO era)
-> ([UTxO era] -> UTxO era)
-> Monoid (UTxO era)
[UTxO era] -> UTxO era
UTxO era -> UTxO era -> UTxO era
forall era. Semigroup (UTxO era)
forall era. UTxO era
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall era. [UTxO era] -> UTxO era
forall era. UTxO era -> UTxO era -> UTxO era
$cmempty :: forall era. UTxO era
mempty :: UTxO era
$cmappend :: forall era. UTxO era -> UTxO era -> UTxO era
mappend :: UTxO era -> UTxO era -> UTxO era
$cmconcat :: forall era. [UTxO era] -> UTxO era
mconcat :: [UTxO era] -> UTxO era
Monoid, Int -> [Item (UTxO era)] -> UTxO era
[Item (UTxO era)] -> UTxO era
UTxO era -> [Item (UTxO era)]
([Item (UTxO era)] -> UTxO era)
-> (Int -> [Item (UTxO era)] -> UTxO era)
-> (UTxO era -> [Item (UTxO era)])
-> IsList (UTxO era)
forall era. Int -> [Item (UTxO era)] -> UTxO era
forall era. [Item (UTxO era)] -> UTxO era
forall era. UTxO era -> [Item (UTxO era)]
forall l.
([Item l] -> l)
-> (Int -> [Item l] -> l) -> (l -> [Item l]) -> IsList l
$cfromList :: forall era. [Item (UTxO era)] -> UTxO era
fromList :: [Item (UTxO era)] -> UTxO era
$cfromListN :: forall era. Int -> [Item (UTxO era)] -> UTxO era
fromListN :: Int -> [Item (UTxO era)] -> UTxO era
$ctoList :: forall era. UTxO era -> [Item (UTxO era)]
toList :: UTxO era -> [Item (UTxO era)]
IsList)

instance IsCardanoEra era => ToJSON (UTxO era) where
  toJSON :: UTxO era -> Value
toJSON (UTxO Map TxIn (TxOut CtxUTxO era)
m) = Map TxIn (TxOut CtxUTxO era) -> Value
forall a. ToJSON a => a -> Value
toJSON Map TxIn (TxOut CtxUTxO era)
m
  toEncoding :: UTxO era -> Encoding
toEncoding (UTxO Map TxIn (TxOut CtxUTxO era)
m) = Map TxIn (TxOut CtxUTxO era) -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Map TxIn (TxOut CtxUTxO era)
m

instance
  IsShelleyBasedEra era
  => FromJSON (UTxO era)
  where
  parseJSON :: Value -> Parser (UTxO era)
parseJSON = String
-> (Object -> Parser (UTxO era)) -> Value -> Parser (UTxO era)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"UTxO" ((Object -> Parser (UTxO era)) -> Value -> Parser (UTxO era))
-> (Object -> Parser (UTxO era)) -> Value -> Parser (UTxO era)
forall a b. (a -> b) -> a -> b
$ \Object
hm -> do
    let l :: [Item (HashMap Text Value)]
l = HashMap Text Value -> [Item (HashMap Text Value)]
forall l. IsList l => l -> [Item l]
toList (HashMap Text Value -> [Item (HashMap Text Value)])
-> HashMap Text Value -> [Item (HashMap Text Value)]
forall a b. (a -> b) -> a -> b
$ Object -> HashMap Text Value
forall v. KeyMap v -> HashMap Text v
KeyMap.toHashMapText Object
hm
    [(TxIn, TxOut CtxUTxO era)]
res <- ((Text, Value) -> Parser (TxIn, TxOut CtxUTxO era))
-> [(Text, Value)] -> Parser [(TxIn, TxOut CtxUTxO era)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Text, Value) -> Parser (TxIn, TxOut CtxUTxO era)
toTxIn [(Text, Value)]
l
    UTxO era -> Parser (UTxO era)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTxO era -> Parser (UTxO era))
-> (Map TxIn (TxOut CtxUTxO era) -> UTxO era)
-> Map TxIn (TxOut CtxUTxO era)
-> Parser (UTxO era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxIn (TxOut CtxUTxO era) -> UTxO era
forall era. Map TxIn (TxOut CtxUTxO era) -> UTxO era
UTxO (Map TxIn (TxOut CtxUTxO era) -> Parser (UTxO era))
-> Map TxIn (TxOut CtxUTxO era) -> Parser (UTxO era)
forall a b. (a -> b) -> a -> b
$ [(TxIn, TxOut CtxUTxO era)] -> Map TxIn (TxOut CtxUTxO era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(TxIn, TxOut CtxUTxO era)]
res
   where
    toTxIn :: (Text, Aeson.Value) -> Parser (TxIn, TxOut CtxUTxO era)
    toTxIn :: (Text, Value) -> Parser (TxIn, TxOut CtxUTxO era)
toTxIn (Text
txinText, Value
txOutVal) = do
      (,)
        (TxIn -> TxOut CtxUTxO era -> (TxIn, TxOut CtxUTxO era))
-> Parser TxIn
-> Parser (TxOut CtxUTxO era -> (TxIn, TxOut CtxUTxO era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser TxIn
forall a. FromJSON a => Value -> Parser a
parseJSON (Text -> Value
Aeson.String Text
txinText)
        Parser (TxOut CtxUTxO era -> (TxIn, TxOut CtxUTxO era))
-> Parser (TxOut CtxUTxO era) -> Parser (TxIn, TxOut CtxUTxO era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser (TxOut CtxUTxO era)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
txOutVal

-- | Infix version of `difference`.
(\\) :: UTxO era -> UTxO era -> UTxO era
UTxO era
a \\ :: forall era. UTxO era -> UTxO era -> UTxO era
\\ UTxO era
b = UTxO era -> UTxO era -> UTxO era
forall era. UTxO era -> UTxO era -> UTxO era
difference UTxO era
a UTxO era
b

-- | Create an empty `UTxO`.
empty :: UTxO era
empty :: forall era. UTxO era
empty = Map TxIn (TxOut CtxUTxO era) -> UTxO era
forall era. Map TxIn (TxOut CtxUTxO era) -> UTxO era
UTxO Map TxIn (TxOut CtxUTxO era)
forall k a. Map k a
Map.empty

-- | Create a `UTxO` from a single unspent transaction output.
singleton :: TxIn -> TxOut CtxUTxO era -> UTxO era
singleton :: forall era. TxIn -> TxOut CtxUTxO era -> UTxO era
singleton TxIn
i TxOut CtxUTxO era
o = Map TxIn (TxOut CtxUTxO era) -> UTxO era
forall era. Map TxIn (TxOut CtxUTxO era) -> UTxO era
UTxO (Map TxIn (TxOut CtxUTxO era) -> UTxO era)
-> Map TxIn (TxOut CtxUTxO era) -> UTxO era
forall a b. (a -> b) -> a -> b
$ TxIn -> TxOut CtxUTxO era -> Map TxIn (TxOut CtxUTxO era)
forall k a. k -> a -> Map k a
Map.singleton TxIn
i TxOut CtxUTxO era
o

-- | Find a 'TxOut' for a given 'TxIn'.
lookup :: TxIn -> UTxO era -> Maybe (TxOut CtxUTxO era)
lookup :: forall era. TxIn -> UTxO era -> Maybe (TxOut CtxUTxO era)
lookup TxIn
k = TxIn -> Map TxIn (TxOut CtxUTxO era) -> Maybe (TxOut CtxUTxO era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn
k (Map TxIn (TxOut CtxUTxO era) -> Maybe (TxOut CtxUTxO era))
-> (UTxO era -> Map TxIn (TxOut CtxUTxO era))
-> UTxO era
-> Maybe (TxOut CtxUTxO era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO era -> Map TxIn (TxOut CtxUTxO era)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
unUTxO

-- | Filter all `TxOut` that satisfy the predicate.
filter :: (TxOut CtxUTxO era -> Bool) -> UTxO era -> UTxO era
filter :: forall era. (TxOut CtxUTxO era -> Bool) -> UTxO era -> UTxO era
filter TxOut CtxUTxO era -> Bool
fn = Map TxIn (TxOut CtxUTxO era) -> UTxO era
forall era. Map TxIn (TxOut CtxUTxO era) -> UTxO era
UTxO (Map TxIn (TxOut CtxUTxO era) -> UTxO era)
-> (UTxO era -> Map TxIn (TxOut CtxUTxO era))
-> UTxO era
-> UTxO era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut CtxUTxO era -> Bool)
-> Map TxIn (TxOut CtxUTxO era) -> Map TxIn (TxOut CtxUTxO era)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter TxOut CtxUTxO era -> Bool
fn (Map TxIn (TxOut CtxUTxO era) -> Map TxIn (TxOut CtxUTxO era))
-> (UTxO era -> Map TxIn (TxOut CtxUTxO era))
-> UTxO era
-> Map TxIn (TxOut CtxUTxO era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO era -> Map TxIn (TxOut CtxUTxO era)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
unUTxO

-- | Filter all UTxO to only include 'out's satisfying given predicate.
filterWithKey :: (TxIn -> TxOut CtxUTxO era -> Bool) -> UTxO era -> UTxO era
filterWithKey :: forall era.
(TxIn -> TxOut CtxUTxO era -> Bool) -> UTxO era -> UTxO era
filterWithKey TxIn -> TxOut CtxUTxO era -> Bool
fn = Map TxIn (TxOut CtxUTxO era) -> UTxO era
forall era. Map TxIn (TxOut CtxUTxO era) -> UTxO era
UTxO (Map TxIn (TxOut CtxUTxO era) -> UTxO era)
-> (UTxO era -> Map TxIn (TxOut CtxUTxO era))
-> UTxO era
-> UTxO era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn -> TxOut CtxUTxO era -> Bool)
-> Map TxIn (TxOut CtxUTxO era) -> Map TxIn (TxOut CtxUTxO era)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey TxIn -> TxOut CtxUTxO era -> Bool
fn (Map TxIn (TxOut CtxUTxO era) -> Map TxIn (TxOut CtxUTxO era))
-> (UTxO era -> Map TxIn (TxOut CtxUTxO era))
-> UTxO era
-> Map TxIn (TxOut CtxUTxO era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO era -> Map TxIn (TxOut CtxUTxO era)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
unUTxO

-- | Get the 'UTxO domain input's set
inputSet :: UTxO (TxOut CtxUTxO era) -> Set TxIn
inputSet :: forall era. UTxO (TxOut CtxUTxO era) -> Set TxIn
inputSet = Map TxIn (TxOut CtxUTxO (TxOut CtxUTxO era)) -> Set TxIn
forall k a. Map k a -> Set k
Map.keysSet (Map TxIn (TxOut CtxUTxO (TxOut CtxUTxO era)) -> Set TxIn)
-> (UTxO (TxOut CtxUTxO era)
    -> Map TxIn (TxOut CtxUTxO (TxOut CtxUTxO era)))
-> UTxO (TxOut CtxUTxO era)
-> Set TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO (TxOut CtxUTxO era)
-> Map TxIn (TxOut CtxUTxO (TxOut CtxUTxO era))
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
unUTxO

-- | Remove the right hand side from the left hand side.
difference :: UTxO era -> UTxO era -> UTxO era
difference :: forall era. UTxO era -> UTxO era -> UTxO era
difference UTxO era
a UTxO era
b = Map TxIn (TxOut CtxUTxO era) -> UTxO era
forall era. Map TxIn (TxOut CtxUTxO era) -> UTxO era
UTxO (Map TxIn (TxOut CtxUTxO era) -> UTxO era)
-> Map TxIn (TxOut CtxUTxO era) -> UTxO era
forall a b. (a -> b) -> a -> b
$ Map TxIn (TxOut CtxUTxO era)
-> Map TxIn (TxOut CtxUTxO era) -> Map TxIn (TxOut CtxUTxO era)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference (UTxO era -> Map TxIn (TxOut CtxUTxO era)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
unUTxO UTxO era
a) (UTxO era -> Map TxIn (TxOut CtxUTxO era)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
unUTxO UTxO era
b)