{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-missed-specialisations #-}

module Cardano.Chain.UTxO.UTxO
  ( UTxO (..),
    UTxOError (..),
    empty,
    fromList,
    fromBalances,
    fromTxOut,
    toList,
    member,
    lookup,
    lookupCompact,
    lookupAddress,
    union,
    concat,
    balance,
    (<|),
    (</|),
    txOutputUTxO,
    isRedeemUTxO,
  )
where

import Cardano.Binary
  ( DecoderError (..),
    FromCBOR (..),
    ToCBOR (..),
    decodeListLen,
    decodeWord8,
    encodeListLen,
    matchSize,
  )
import Cardano.Chain.Common
  ( Address,
    Lovelace,
    LovelaceError,
    isRedeemAddress,
    sumLovelace,
  )
import Cardano.Chain.UTxO.Compact
  ( CompactTxIn,
    CompactTxOut,
    fromCompactTxIn,
    fromCompactTxOut,
    toCompactTxIn,
    toCompactTxOut,
  )
import Cardano.Chain.UTxO.Tx (Tx (..), TxId, TxIn (..), TxOut (..))
import Cardano.Crypto (serializeCborHash)
import Cardano.Prelude hiding (concat, empty, toList)
import Data.Coerce
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import NoThunks.Class (NoThunks (..))

newtype UTxO = UTxO
  { UTxO -> Map CompactTxIn CompactTxOut
unUTxO :: Map CompactTxIn CompactTxOut
  }
  deriving (UTxO -> UTxO -> Bool
(UTxO -> UTxO -> Bool) -> (UTxO -> UTxO -> Bool) -> Eq UTxO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UTxO -> UTxO -> Bool
$c/= :: UTxO -> UTxO -> Bool
== :: UTxO -> UTxO -> Bool
$c== :: UTxO -> UTxO -> Bool
Eq, Int -> UTxO -> ShowS
[UTxO] -> ShowS
UTxO -> String
(Int -> UTxO -> ShowS)
-> (UTxO -> String) -> ([UTxO] -> ShowS) -> Show UTxO
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UTxO] -> ShowS
$cshowList :: [UTxO] -> ShowS
show :: UTxO -> String
$cshow :: UTxO -> String
showsPrec :: Int -> UTxO -> ShowS
$cshowsPrec :: Int -> UTxO -> ShowS
Show, (forall x. UTxO -> Rep UTxO x)
-> (forall x. Rep UTxO x -> UTxO) -> Generic UTxO
forall x. Rep UTxO x -> UTxO
forall x. UTxO -> Rep UTxO x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UTxO x -> UTxO
$cfrom :: forall x. UTxO -> Rep UTxO x
Generic)
  deriving newtype (UTxO -> Int
(UTxO -> Int) -> HeapWords UTxO
forall a. (a -> Int) -> HeapWords a
heapWords :: UTxO -> Int
$cheapWords :: UTxO -> Int
HeapWords, Typeable UTxO
Decoder s UTxO
Typeable UTxO
-> (forall s. Decoder s UTxO)
-> (Proxy UTxO -> Text)
-> FromCBOR UTxO
Proxy UTxO -> Text
forall s. Decoder s UTxO
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
label :: Proxy UTxO -> Text
$clabel :: Proxy UTxO -> Text
fromCBOR :: Decoder s UTxO
$cfromCBOR :: forall s. Decoder s UTxO
$cp1FromCBOR :: Typeable UTxO
FromCBOR, Typeable UTxO
Typeable UTxO
-> (UTxO -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy UTxO -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [UTxO] -> Size)
-> ToCBOR UTxO
UTxO -> Encoding
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [UTxO] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy UTxO -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [UTxO] -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [UTxO] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy UTxO -> Size
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy UTxO -> Size
toCBOR :: UTxO -> Encoding
$ctoCBOR :: UTxO -> Encoding
$cp1ToCBOR :: Typeable UTxO
ToCBOR)
  deriving anyclass (UTxO -> ()
(UTxO -> ()) -> NFData UTxO
forall a. (a -> ()) -> NFData a
rnf :: UTxO -> ()
$crnf :: UTxO -> ()
NFData, Context -> UTxO -> IO (Maybe ThunkInfo)
Proxy UTxO -> String
(Context -> UTxO -> IO (Maybe ThunkInfo))
-> (Context -> UTxO -> IO (Maybe ThunkInfo))
-> (Proxy UTxO -> String)
-> NoThunks UTxO
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy UTxO -> String
$cshowTypeOf :: Proxy UTxO -> String
wNoThunks :: Context -> UTxO -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> UTxO -> IO (Maybe ThunkInfo)
noThunks :: Context -> UTxO -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> UTxO -> IO (Maybe ThunkInfo)
NoThunks)

data UTxOError
  = UTxOMissingInput TxIn
  | UTxOOverlappingUnion
  deriving (UTxOError -> UTxOError -> Bool
(UTxOError -> UTxOError -> Bool)
-> (UTxOError -> UTxOError -> Bool) -> Eq UTxOError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UTxOError -> UTxOError -> Bool
$c/= :: UTxOError -> UTxOError -> Bool
== :: UTxOError -> UTxOError -> Bool
$c== :: UTxOError -> UTxOError -> Bool
Eq, Int -> UTxOError -> ShowS
[UTxOError] -> ShowS
UTxOError -> String
(Int -> UTxOError -> ShowS)
-> (UTxOError -> String)
-> ([UTxOError] -> ShowS)
-> Show UTxOError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UTxOError] -> ShowS
$cshowList :: [UTxOError] -> ShowS
show :: UTxOError -> String
$cshow :: UTxOError -> String
showsPrec :: Int -> UTxOError -> ShowS
$cshowsPrec :: Int -> UTxOError -> ShowS
Show)

instance ToCBOR UTxOError where
  toCBOR :: UTxOError -> Encoding
toCBOR = \case
    UTxOMissingInput TxIn
txIn ->
      Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR @Word8 Word8
0 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TxIn -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR TxIn
txIn
    UTxOError
UTxOOverlappingUnion ->
      Word -> Encoding
encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR @Word8 Word8
1

instance FromCBOR UTxOError where
  fromCBOR :: Decoder s UTxOError
fromCBOR = do
    Int
len <- Decoder s Int
forall s. Decoder s Int
decodeListLen
    Word8
tag <- Decoder s Word8
forall s. Decoder s Word8
decodeWord8
    case Word8
tag of
      Word8
0 -> Text -> Int -> Int -> Decoder s ()
forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"UTxOError" Int
2 Int
len Decoder s () -> Decoder s UTxOError -> Decoder s UTxOError
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TxIn -> UTxOError
UTxOMissingInput (TxIn -> UTxOError) -> Decoder s TxIn -> Decoder s UTxOError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s TxIn
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word8
1 -> Text -> Int -> Int -> Decoder s ()
forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"UTxOError" Int
1 Int
len Decoder s () -> UTxOError -> Decoder s UTxOError
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> UTxOError
UTxOOverlappingUnion
      Word8
_ -> DecoderError -> Decoder s UTxOError
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s UTxOError)
-> DecoderError -> Decoder s UTxOError
forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"UTxOError" Word8
tag

empty :: UTxO
empty :: UTxO
empty = Map CompactTxIn CompactTxOut -> UTxO
UTxO Map CompactTxIn CompactTxOut
forall a. Monoid a => a
mempty

fromList :: [(TxIn, TxOut)] -> UTxO
fromList :: [(TxIn, TxOut)] -> UTxO
fromList = Map CompactTxIn CompactTxOut -> UTxO
UTxO (Map CompactTxIn CompactTxOut -> UTxO)
-> ([(TxIn, TxOut)] -> Map CompactTxIn CompactTxOut)
-> [(TxIn, TxOut)]
-> UTxO
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [(CompactTxIn, CompactTxOut)] -> Map CompactTxIn CompactTxOut
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(CompactTxIn, CompactTxOut)] -> Map CompactTxIn CompactTxOut)
-> ([(TxIn, TxOut)] -> [(CompactTxIn, CompactTxOut)])
-> [(TxIn, TxOut)]
-> Map CompactTxIn CompactTxOut
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [(TxIn, TxOut)] -> [(CompactTxIn, CompactTxOut)]
toCompactTxInTxOutList
  where
    toCompactTxInTxOutList :: [(TxIn, TxOut)] -> [(CompactTxIn, CompactTxOut)]
    toCompactTxInTxOutList :: [(TxIn, TxOut)] -> [(CompactTxIn, CompactTxOut)]
toCompactTxInTxOutList = ((TxIn, TxOut) -> (CompactTxIn, CompactTxOut))
-> [(TxIn, TxOut)] -> [(CompactTxIn, CompactTxOut)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((TxIn -> CompactTxIn)
-> (TxOut -> CompactTxOut)
-> (TxIn, TxOut)
-> (CompactTxIn, CompactTxOut)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap TxIn -> CompactTxIn
toCompactTxIn TxOut -> CompactTxOut
toCompactTxOut)

-- | Create a 'UTxO' from a list of initial balances
fromBalances :: [(Address, Lovelace)] -> UTxO
fromBalances :: [(Address, Lovelace)] -> UTxO
fromBalances =
  UTxO -> Either UTxOError UTxO -> UTxO
forall b a. b -> Either a b -> b
fromRight (Text -> UTxO
forall a. HasCallStack => Text -> a
panic Text
"fromBalances: duplicate Address in initial balances")
    (Either UTxOError UTxO -> UTxO)
-> ([(Address, Lovelace)] -> Either UTxOError UTxO)
-> [(Address, Lovelace)]
-> UTxO
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [UTxO] -> Either UTxOError UTxO
forall (m :: * -> *). MonadError UTxOError m => [UTxO] -> m UTxO
concat
    ([UTxO] -> Either UTxOError UTxO)
-> ([(Address, Lovelace)] -> [UTxO])
-> [(Address, Lovelace)]
-> Either UTxOError UTxO
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((Address, Lovelace) -> UTxO) -> [(Address, Lovelace)] -> [UTxO]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxOut -> UTxO
fromTxOut (TxOut -> UTxO)
-> ((Address, Lovelace) -> TxOut) -> (Address, Lovelace) -> UTxO
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Address -> Lovelace -> TxOut) -> (Address, Lovelace) -> TxOut
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Address -> Lovelace -> TxOut
TxOut)

-- | Construct a UTxO from a TxOut. This UTxO is a singleton with a TxIn that
-- references an address constructed by hashing the TxOut address. This means
-- it is not guaranteed (or likely) to be a real address.
fromTxOut :: TxOut -> UTxO
fromTxOut :: TxOut -> UTxO
fromTxOut TxOut
out = [(TxIn, TxOut)] -> UTxO
fromList [(TxId -> Word16 -> TxIn
TxInUtxo (AbstractHash Blake2b_256 Address -> TxId
coerce (AbstractHash Blake2b_256 Address -> TxId)
-> (Address -> AbstractHash Blake2b_256 Address) -> Address -> TxId
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Address -> AbstractHash Blake2b_256 Address
forall a. ToCBOR a => a -> Hash a
serializeCborHash (Address -> TxId) -> Address -> TxId
forall a b. (a -> b) -> a -> b
$ TxOut -> Address
txOutAddress TxOut
out) Word16
0, TxOut
out)]

toList :: UTxO -> [(TxIn, TxOut)]
toList :: UTxO -> [(TxIn, TxOut)]
toList = ((CompactTxIn, CompactTxOut) -> (TxIn, TxOut))
-> [(CompactTxIn, CompactTxOut)] -> [(TxIn, TxOut)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CompactTxIn -> TxIn)
-> (CompactTxOut -> TxOut)
-> (CompactTxIn, CompactTxOut)
-> (TxIn, TxOut)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap CompactTxIn -> TxIn
fromCompactTxIn CompactTxOut -> TxOut
fromCompactTxOut) ([(CompactTxIn, CompactTxOut)] -> [(TxIn, TxOut)])
-> (UTxO -> [(CompactTxIn, CompactTxOut)])
-> UTxO
-> [(TxIn, TxOut)]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Map CompactTxIn CompactTxOut -> [(CompactTxIn, CompactTxOut)]
forall k a. Map k a -> [(k, a)]
M.toList (Map CompactTxIn CompactTxOut -> [(CompactTxIn, CompactTxOut)])
-> (UTxO -> Map CompactTxIn CompactTxOut)
-> UTxO
-> [(CompactTxIn, CompactTxOut)]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UTxO -> Map CompactTxIn CompactTxOut
unUTxO

member :: TxIn -> UTxO -> Bool
member :: TxIn -> UTxO -> Bool
member TxIn
txIn = CompactTxIn -> Map CompactTxIn CompactTxOut -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member (TxIn -> CompactTxIn
toCompactTxIn TxIn
txIn) (Map CompactTxIn CompactTxOut -> Bool)
-> (UTxO -> Map CompactTxIn CompactTxOut) -> UTxO -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UTxO -> Map CompactTxIn CompactTxOut
unUTxO

lookup :: TxIn -> UTxO -> Maybe TxOut
lookup :: TxIn -> UTxO -> Maybe TxOut
lookup TxIn
txIn = (CompactTxOut -> TxOut) -> Maybe CompactTxOut -> Maybe TxOut
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompactTxOut -> TxOut
fromCompactTxOut (Maybe CompactTxOut -> Maybe TxOut)
-> (UTxO -> Maybe CompactTxOut) -> UTxO -> Maybe TxOut
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CompactTxIn -> Map CompactTxIn CompactTxOut -> Maybe CompactTxOut
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (TxIn -> CompactTxIn
toCompactTxIn TxIn
txIn) (Map CompactTxIn CompactTxOut -> Maybe CompactTxOut)
-> (UTxO -> Map CompactTxIn CompactTxOut)
-> UTxO
-> Maybe CompactTxOut
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UTxO -> Map CompactTxIn CompactTxOut
unUTxO

lookupCompact :: CompactTxIn -> UTxO -> Maybe CompactTxOut
lookupCompact :: CompactTxIn -> UTxO -> Maybe CompactTxOut
lookupCompact CompactTxIn
txIn = CompactTxIn -> Map CompactTxIn CompactTxOut -> Maybe CompactTxOut
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup CompactTxIn
txIn (Map CompactTxIn CompactTxOut -> Maybe CompactTxOut)
-> (UTxO -> Map CompactTxIn CompactTxOut)
-> UTxO
-> Maybe CompactTxOut
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UTxO -> Map CompactTxIn CompactTxOut
unUTxO

lookupAddress :: TxIn -> UTxO -> Either UTxOError Address
lookupAddress :: TxIn -> UTxO -> Either UTxOError Address
lookupAddress TxIn
txIn =
  Either UTxOError Address
-> (CompactTxOut -> Either UTxOError Address)
-> Maybe CompactTxOut
-> Either UTxOError Address
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (UTxOError -> Either UTxOError Address
forall a b. a -> Either a b
Left (UTxOError -> Either UTxOError Address)
-> UTxOError -> Either UTxOError Address
forall a b. (a -> b) -> a -> b
$ TxIn -> UTxOError
UTxOMissingInput TxIn
txIn) (Address -> Either UTxOError Address
forall a b. b -> Either a b
Right (Address -> Either UTxOError Address)
-> (CompactTxOut -> Address)
-> CompactTxOut
-> Either UTxOError Address
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TxOut -> Address
txOutAddress (TxOut -> Address)
-> (CompactTxOut -> TxOut) -> CompactTxOut -> Address
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CompactTxOut -> TxOut
fromCompactTxOut)
    (Maybe CompactTxOut -> Either UTxOError Address)
-> (UTxO -> Maybe CompactTxOut) -> UTxO -> Either UTxOError Address
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CompactTxIn -> Map CompactTxIn CompactTxOut -> Maybe CompactTxOut
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (TxIn -> CompactTxIn
toCompactTxIn TxIn
txIn)
    (Map CompactTxIn CompactTxOut -> Maybe CompactTxOut)
-> (UTxO -> Map CompactTxIn CompactTxOut)
-> UTxO
-> Maybe CompactTxOut
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UTxO -> Map CompactTxIn CompactTxOut
unUTxO

union :: MonadError UTxOError m => UTxO -> UTxO -> m UTxO
union :: UTxO -> UTxO -> m UTxO
union (UTxO Map CompactTxIn CompactTxOut
m) (UTxO Map CompactTxIn CompactTxOut
m') = do
  let m'' :: Map CompactTxIn CompactTxOut
m'' = Map CompactTxIn CompactTxOut
-> Map CompactTxIn CompactTxOut -> Map CompactTxIn CompactTxOut
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map CompactTxIn CompactTxOut
m Map CompactTxIn CompactTxOut
m'
  (Map CompactTxIn CompactTxOut -> Int
forall k a. Map k a -> Int
M.size Map CompactTxIn CompactTxOut
m'' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Map CompactTxIn CompactTxOut -> Int
forall k a. Map k a -> Int
M.size Map CompactTxIn CompactTxOut
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Map CompactTxIn CompactTxOut -> Int
forall k a. Map k a -> Int
M.size Map CompactTxIn CompactTxOut
m') Bool -> UTxOError -> m ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` UTxOError
UTxOOverlappingUnion
  UTxO -> m UTxO
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTxO -> m UTxO) -> UTxO -> m UTxO
forall a b. (a -> b) -> a -> b
$ Map CompactTxIn CompactTxOut -> UTxO
UTxO Map CompactTxIn CompactTxOut
m''

concat :: MonadError UTxOError m => [UTxO] -> m UTxO
concat :: [UTxO] -> m UTxO
concat = (UTxO -> UTxO -> m UTxO) -> UTxO -> [UTxO] -> m UTxO
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM UTxO -> UTxO -> m UTxO
forall (m :: * -> *).
MonadError UTxOError m =>
UTxO -> UTxO -> m UTxO
union UTxO
empty

balance :: UTxO -> Either LovelaceError Lovelace
balance :: UTxO -> Either LovelaceError Lovelace
balance = [Lovelace] -> Either LovelaceError Lovelace
forall (t :: * -> *).
(Foldable t, Functor t) =>
t Lovelace -> Either LovelaceError Lovelace
sumLovelace ([Lovelace] -> Either LovelaceError Lovelace)
-> (UTxO -> [Lovelace]) -> UTxO -> Either LovelaceError Lovelace
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (CompactTxOut -> Lovelace) -> [CompactTxOut] -> [Lovelace]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompactTxOut -> Lovelace
compactTxOutValue ([CompactTxOut] -> [Lovelace])
-> (UTxO -> [CompactTxOut]) -> UTxO -> [Lovelace]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Map CompactTxIn CompactTxOut -> [CompactTxOut]
forall k a. Map k a -> [a]
M.elems (Map CompactTxIn CompactTxOut -> [CompactTxOut])
-> (UTxO -> Map CompactTxIn CompactTxOut) -> UTxO -> [CompactTxOut]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UTxO -> Map CompactTxIn CompactTxOut
unUTxO
  where
    compactTxOutValue :: CompactTxOut -> Lovelace
    compactTxOutValue :: CompactTxOut -> Lovelace
compactTxOutValue = TxOut -> Lovelace
txOutValue (TxOut -> Lovelace)
-> (CompactTxOut -> TxOut) -> CompactTxOut -> Lovelace
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CompactTxOut -> TxOut
fromCompactTxOut

(<|) :: Set TxIn -> UTxO -> UTxO
<| :: Set TxIn -> UTxO -> UTxO
(<|) Set TxIn
inputs = Map CompactTxIn CompactTxOut -> UTxO
UTxO (Map CompactTxIn CompactTxOut -> UTxO)
-> (UTxO -> Map CompactTxIn CompactTxOut) -> UTxO -> UTxO
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Map CompactTxIn CompactTxOut
 -> Set CompactTxIn -> Map CompactTxIn CompactTxOut)
-> Set CompactTxIn
-> Map CompactTxIn CompactTxOut
-> Map CompactTxIn CompactTxOut
forall a b c. (a -> b -> c) -> b -> a -> c
flip Map CompactTxIn CompactTxOut
-> Set CompactTxIn -> Map CompactTxIn CompactTxOut
forall k a. Ord k => Map k a -> Set k -> Map k a
M.restrictKeys Set CompactTxIn
compactInputs (Map CompactTxIn CompactTxOut -> Map CompactTxIn CompactTxOut)
-> (UTxO -> Map CompactTxIn CompactTxOut)
-> UTxO
-> Map CompactTxIn CompactTxOut
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UTxO -> Map CompactTxIn CompactTxOut
unUTxO
  where
    compactInputs :: Set CompactTxIn
compactInputs = (TxIn -> CompactTxIn) -> Set TxIn -> Set CompactTxIn
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map TxIn -> CompactTxIn
toCompactTxIn Set TxIn
inputs

(</|) :: Set TxIn -> UTxO -> UTxO
</| :: Set TxIn -> UTxO -> UTxO
(</|) Set TxIn
inputs = Map CompactTxIn CompactTxOut -> UTxO
UTxO (Map CompactTxIn CompactTxOut -> UTxO)
-> (UTxO -> Map CompactTxIn CompactTxOut) -> UTxO -> UTxO
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Map CompactTxIn CompactTxOut
 -> Set CompactTxIn -> Map CompactTxIn CompactTxOut)
-> Set CompactTxIn
-> Map CompactTxIn CompactTxOut
-> Map CompactTxIn CompactTxOut
forall a b c. (a -> b -> c) -> b -> a -> c
flip Map CompactTxIn CompactTxOut
-> Set CompactTxIn -> Map CompactTxIn CompactTxOut
forall k a. Ord k => Map k a -> Set k -> Map k a
M.withoutKeys Set CompactTxIn
compactInputs (Map CompactTxIn CompactTxOut -> Map CompactTxIn CompactTxOut)
-> (UTxO -> Map CompactTxIn CompactTxOut)
-> UTxO
-> Map CompactTxIn CompactTxOut
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UTxO -> Map CompactTxIn CompactTxOut
unUTxO
  where
    compactInputs :: Set CompactTxIn
compactInputs = (TxIn -> CompactTxIn) -> Set TxIn -> Set CompactTxIn
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map TxIn -> CompactTxIn
toCompactTxIn Set TxIn
inputs

txOutputUTxO :: Tx -> UTxO
txOutputUTxO :: Tx -> UTxO
txOutputUTxO Tx
tx =
  Map CompactTxIn CompactTxOut -> UTxO
UTxO (Map CompactTxIn CompactTxOut -> UTxO)
-> Map CompactTxIn CompactTxOut -> UTxO
forall a b. (a -> b) -> a -> b
$
    [(CompactTxIn, CompactTxOut)] -> Map CompactTxIn CompactTxOut
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
      [ (TxIn -> CompactTxIn
toCompactTxIn (TxId -> Word16 -> TxIn
TxInUtxo (Tx -> TxId
txId Tx
tx) Word16
ix), (TxOut -> CompactTxOut
toCompactTxOut TxOut
txOut))
        | (Word16
ix, TxOut
txOut) <- [(Word16, TxOut)]
indexedOutputs
      ]
  where
    indexedOutputs :: [(Word16, TxOut)]
    indexedOutputs :: [(Word16, TxOut)]
indexedOutputs = [Word16] -> [TxOut] -> [(Word16, TxOut)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word16
0 ..] (NonEmpty TxOut -> [TxOut]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty TxOut -> [TxOut]) -> NonEmpty TxOut -> [TxOut]
forall a b. (a -> b) -> a -> b
$ Tx -> NonEmpty TxOut
txOutputs Tx
tx)

    txId :: Tx -> TxId
    txId :: Tx -> TxId
txId = Tx -> TxId
forall a. ToCBOR a => a -> Hash a
serializeCborHash

isRedeemUTxO :: UTxO -> Bool
isRedeemUTxO :: UTxO -> Bool
isRedeemUTxO =
  (CompactTxOut -> Bool) -> [CompactTxOut] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Address -> Bool
isRedeemAddress (Address -> Bool)
-> (CompactTxOut -> Address) -> CompactTxOut -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TxOut -> Address
txOutAddress (TxOut -> Address)
-> (CompactTxOut -> TxOut) -> CompactTxOut -> Address
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CompactTxOut -> TxOut
fromCompactTxOut)
    ([CompactTxOut] -> Bool)
-> (UTxO -> [CompactTxOut]) -> UTxO -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Map CompactTxIn CompactTxOut -> [CompactTxOut]
forall k a. Map k a -> [a]
M.elems
    (Map CompactTxIn CompactTxOut -> [CompactTxOut])
-> (UTxO -> Map CompactTxIn CompactTxOut) -> UTxO -> [CompactTxOut]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UTxO -> Map CompactTxIn CompactTxOut
unUTxO