{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs              #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE NamedFieldPuns     #-}
{-# LANGUAGE TupleSections      #-}
module Convex.Event(
    Extract,
    TxWithEvents(..),
    NewOutputEvent(..),
    OutputSpentEvent(..),
    Event(..),
    ScriptOutDataHash,
    ScriptOut,
    txIn,
    splitEvent,
    -- * Extraction
    ResolvedInputs(..),
    extract,
    convertScript,
    extractBabbageTxn',
    extractBabbageTxn
    ) where

import           Cardano.Api                        (BabbageEra, Block (..),
                                                     BlockHeader,
                                                     BlockInMode (..), BlockNo,
                                                     CardanoMode,
                                                     EraInMode (..), ScriptHash,
                                                     SlotNo, Tx (..), TxId,
                                                     TxIn (..), TxIx (..))
import qualified Cardano.Api                        as C
import           Cardano.Api.Shelley                (TxBody (..))
import qualified Cardano.Api.Shelley                as CS
import qualified Cardano.Ledger.Address             as Address
import qualified Cardano.Ledger.Alonzo.Scripts      as Scripts
import           Cardano.Ledger.Alonzo.Scripts.Data (Data, DataHash)
import           Cardano.Ledger.Alonzo.TxAuxData    (AlonzoTxAuxData (..))
import qualified Cardano.Ledger.Alonzo.TxWits       as TxWitness
import qualified Cardano.Ledger.Babbage             as Babbage
import qualified Cardano.Ledger.Babbage.TxBody      as Babbage.TxBody
import qualified Cardano.Ledger.Babbage.TxOut
import qualified Cardano.Ledger.BaseTypes           as CT
import qualified Cardano.Ledger.Binary
import qualified Cardano.Ledger.Credential          as Credential
import           Cardano.Ledger.Crypto              (StandardCrypto)
import qualified Cardano.Ledger.Era                 as Era
import           Cardano.Ledger.Keys                (KeyHash, KeyRole (Witness))
import           Cardano.Ledger.Shelley.TxAuxData   (Metadatum)
import           Cardano.Ledger.Shelley.TxBody      (witVKeyHash)
import qualified Cardano.Ledger.TxIn                as CT
import           Control.Monad.State.Strict         (MonadState, get, put,
                                                     runState)
import           Convex.Era                         (ERA)
import           Data.Bifunctor                     (Bifunctor (..))
import           Data.Foldable                      (foldl', toList)
import           Data.List                          (sortOn)
import           Data.List.NonEmpty                 (NonEmpty (..))
import           Data.Map.Strict                    (Map)
import qualified Data.Map.Strict                    as Map
import           Data.Maybe                         (catMaybes, mapMaybe,
                                                     maybeToList)
import qualified Data.Set                           as Set
import           Data.Word                          (Word64)
import           GHC.Generics                       (Generic)
import           Ouroboros.Consensus.Shelley.Eras   (StandardBabbage)

type ScriptOutDataHash = DataHash (Era.EraCrypto ERA)

type Extract a = C.TxOut C.CtxTx C.BabbageEra -> ScriptHash -> Maybe a

data Event a =
  AnOutputSpentEvent !(OutputSpentEvent a)
  | ANewOutputEvent !(NewOutputEvent a)
  deriving stock (Event a -> Event a -> Bool
forall a. Eq a => Event a -> Event a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event a -> Event a -> Bool
$c/= :: forall a. Eq a => Event a -> Event a -> Bool
== :: Event a -> Event a -> Bool
$c== :: forall a. Eq a => Event a -> Event a -> Bool
Eq, Int -> Event a -> ShowS
forall a. Show a => Int -> Event a -> ShowS
forall a. Show a => [Event a] -> ShowS
forall a. Show a => Event a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event a] -> ShowS
$cshowList :: forall a. Show a => [Event a] -> ShowS
show :: Event a -> String
$cshow :: forall a. Show a => Event a -> String
showsPrec :: Int -> Event a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Event a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Event a) x -> Event a
forall a x. Event a -> Rep (Event a) x
$cto :: forall a x. Rep (Event a) x -> Event a
$cfrom :: forall a x. Event a -> Rep (Event a) x
Generic, forall a b. a -> Event b -> Event a
forall a b. (a -> b) -> Event a -> Event b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Event b -> Event a
$c<$ :: forall a b. a -> Event b -> Event a
fmap :: forall a b. (a -> b) -> Event a -> Event b
$cfmap :: forall a b. (a -> b) -> Event a -> Event b
Functor, forall a. Eq a => a -> Event a -> Bool
forall a. Num a => Event a -> a
forall a. Ord a => Event a -> a
forall m. Monoid m => Event m -> m
forall a. Event a -> Bool
forall a. Event a -> Int
forall a. Event a -> [a]
forall a. (a -> a -> a) -> Event a -> a
forall m a. Monoid m => (a -> m) -> Event a -> m
forall b a. (b -> a -> b) -> b -> Event a -> b
forall a b. (a -> b -> b) -> b -> Event a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Event a -> a
$cproduct :: forall a. Num a => Event a -> a
sum :: forall a. Num a => Event a -> a
$csum :: forall a. Num a => Event a -> a
minimum :: forall a. Ord a => Event a -> a
$cminimum :: forall a. Ord a => Event a -> a
maximum :: forall a. Ord a => Event a -> a
$cmaximum :: forall a. Ord a => Event a -> a
elem :: forall a. Eq a => a -> Event a -> Bool
$celem :: forall a. Eq a => a -> Event a -> Bool
length :: forall a. Event a -> Int
$clength :: forall a. Event a -> Int
null :: forall a. Event a -> Bool
$cnull :: forall a. Event a -> Bool
toList :: forall a. Event a -> [a]
$ctoList :: forall a. Event a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Event a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Event a -> a
foldr1 :: forall a. (a -> a -> a) -> Event a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Event a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Event a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Event a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Event a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Event a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Event a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Event a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Event a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Event a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Event a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Event a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Event a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Event a -> m
fold :: forall m. Monoid m => Event m -> m
$cfold :: forall m. Monoid m => Event m -> m
Foldable, Functor Event
Foldable Event
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Event (m a) -> m (Event a)
forall (f :: * -> *) a. Applicative f => Event (f a) -> f (Event a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Event a -> m (Event b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Event a -> f (Event b)
sequence :: forall (m :: * -> *) a. Monad m => Event (m a) -> m (Event a)
$csequence :: forall (m :: * -> *) a. Monad m => Event (m a) -> m (Event a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Event a -> m (Event b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Event a -> m (Event b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Event (f a) -> f (Event a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Event (f a) -> f (Event a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Event a -> f (Event b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Event a -> f (Event b)
Traversable)

{-| A transaction annotated with events extracted from it.
-}
data TxWithEvents a =
  TxWithEvents
    { forall a. TxWithEvents a -> Tx BabbageEra
twTx     :: !(Tx BabbageEra)
    , forall a. TxWithEvents a -> NonEmpty (Event a)
twEvents :: !(NonEmpty (Event a))
    , forall a. TxWithEvents a -> BlockNo
twBlock  :: !BlockNo
    , forall a. TxWithEvents a -> SlotNo
twSlot   :: !SlotNo
    } deriving stock (TxWithEvents a -> TxWithEvents a -> Bool
forall a. Eq a => TxWithEvents a -> TxWithEvents a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxWithEvents a -> TxWithEvents a -> Bool
$c/= :: forall a. Eq a => TxWithEvents a -> TxWithEvents a -> Bool
== :: TxWithEvents a -> TxWithEvents a -> Bool
$c== :: forall a. Eq a => TxWithEvents a -> TxWithEvents a -> Bool
Eq, Int -> TxWithEvents a -> ShowS
forall a. Show a => Int -> TxWithEvents a -> ShowS
forall a. Show a => [TxWithEvents a] -> ShowS
forall a. Show a => TxWithEvents a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxWithEvents a] -> ShowS
$cshowList :: forall a. Show a => [TxWithEvents a] -> ShowS
show :: TxWithEvents a -> String
$cshow :: forall a. Show a => TxWithEvents a -> String
showsPrec :: Int -> TxWithEvents a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> TxWithEvents a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (TxWithEvents a) x -> TxWithEvents a
forall a x. TxWithEvents a -> Rep (TxWithEvents a) x
$cto :: forall a x. Rep (TxWithEvents a) x -> TxWithEvents a
$cfrom :: forall a x. TxWithEvents a -> Rep (TxWithEvents a) x
Generic, forall a b. a -> TxWithEvents b -> TxWithEvents a
forall a b. (a -> b) -> TxWithEvents a -> TxWithEvents b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> TxWithEvents b -> TxWithEvents a
$c<$ :: forall a b. a -> TxWithEvents b -> TxWithEvents a
fmap :: forall a b. (a -> b) -> TxWithEvents a -> TxWithEvents b
$cfmap :: forall a b. (a -> b) -> TxWithEvents a -> TxWithEvents b
Functor, forall a. Eq a => a -> TxWithEvents a -> Bool
forall a. Num a => TxWithEvents a -> a
forall a. Ord a => TxWithEvents a -> a
forall m. Monoid m => TxWithEvents m -> m
forall a. TxWithEvents a -> Bool
forall a. TxWithEvents a -> Int
forall a. TxWithEvents a -> [a]
forall a. (a -> a -> a) -> TxWithEvents a -> a
forall m a. Monoid m => (a -> m) -> TxWithEvents a -> m
forall b a. (b -> a -> b) -> b -> TxWithEvents a -> b
forall a b. (a -> b -> b) -> b -> TxWithEvents a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => TxWithEvents a -> a
$cproduct :: forall a. Num a => TxWithEvents a -> a
sum :: forall a. Num a => TxWithEvents a -> a
$csum :: forall a. Num a => TxWithEvents a -> a
minimum :: forall a. Ord a => TxWithEvents a -> a
$cminimum :: forall a. Ord a => TxWithEvents a -> a
maximum :: forall a. Ord a => TxWithEvents a -> a
$cmaximum :: forall a. Ord a => TxWithEvents a -> a
elem :: forall a. Eq a => a -> TxWithEvents a -> Bool
$celem :: forall a. Eq a => a -> TxWithEvents a -> Bool
length :: forall a. TxWithEvents a -> Int
$clength :: forall a. TxWithEvents a -> Int
null :: forall a. TxWithEvents a -> Bool
$cnull :: forall a. TxWithEvents a -> Bool
toList :: forall a. TxWithEvents a -> [a]
$ctoList :: forall a. TxWithEvents a -> [a]
foldl1 :: forall a. (a -> a -> a) -> TxWithEvents a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> TxWithEvents a -> a
foldr1 :: forall a. (a -> a -> a) -> TxWithEvents a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> TxWithEvents a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> TxWithEvents a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> TxWithEvents a -> b
foldl :: forall b a. (b -> a -> b) -> b -> TxWithEvents a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> TxWithEvents a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> TxWithEvents a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> TxWithEvents a -> b
foldr :: forall a b. (a -> b -> b) -> b -> TxWithEvents a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> TxWithEvents a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> TxWithEvents a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> TxWithEvents a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> TxWithEvents a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> TxWithEvents a -> m
fold :: forall m. Monoid m => TxWithEvents m -> m
$cfold :: forall m. Monoid m => TxWithEvents m -> m
Foldable, Functor TxWithEvents
Foldable TxWithEvents
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
TxWithEvents (m a) -> m (TxWithEvents a)
forall (f :: * -> *) a.
Applicative f =>
TxWithEvents (f a) -> f (TxWithEvents a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TxWithEvents a -> m (TxWithEvents b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TxWithEvents a -> f (TxWithEvents b)
sequence :: forall (m :: * -> *) a.
Monad m =>
TxWithEvents (m a) -> m (TxWithEvents a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
TxWithEvents (m a) -> m (TxWithEvents a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TxWithEvents a -> m (TxWithEvents b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TxWithEvents a -> m (TxWithEvents b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
TxWithEvents (f a) -> f (TxWithEvents a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
TxWithEvents (f a) -> f (TxWithEvents a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TxWithEvents a -> f (TxWithEvents b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TxWithEvents a -> f (TxWithEvents b)
Traversable)

splitEvent :: Event a -> Either (OutputSpentEvent a) (NewOutputEvent a)
splitEvent :: forall a. Event a -> Either (OutputSpentEvent a) (NewOutputEvent a)
splitEvent = \case
  AnOutputSpentEvent OutputSpentEvent a
e -> forall a b. a -> Either a b
Left OutputSpentEvent a
e
  ANewOutputEvent NewOutputEvent a
e    -> forall a b. b -> Either a b
Right NewOutputEvent a
e

data OutputSpentEvent a =
  OutputSpentEvent
      { forall a. OutputSpentEvent a -> TxIn
oseTxIn       :: !TxIn
      , forall a. OutputSpentEvent a -> Data StandardBabbage
oseRedeemer   :: !(Data StandardBabbage)
      , forall a. OutputSpentEvent a -> Data StandardBabbage
oseDatum      :: !(Data StandardBabbage)
      , forall a. OutputSpentEvent a -> TxId
oseSpendingTx :: !TxId
      , forall a. OutputSpentEvent a -> NewOutputEvent a
oseTxOutput   :: !(NewOutputEvent a)
      } deriving stock (OutputSpentEvent a -> OutputSpentEvent a -> Bool
forall a. Eq a => OutputSpentEvent a -> OutputSpentEvent a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutputSpentEvent a -> OutputSpentEvent a -> Bool
$c/= :: forall a. Eq a => OutputSpentEvent a -> OutputSpentEvent a -> Bool
== :: OutputSpentEvent a -> OutputSpentEvent a -> Bool
$c== :: forall a. Eq a => OutputSpentEvent a -> OutputSpentEvent a -> Bool
Eq, Int -> OutputSpentEvent a -> ShowS
forall a. Show a => Int -> OutputSpentEvent a -> ShowS
forall a. Show a => [OutputSpentEvent a] -> ShowS
forall a. Show a => OutputSpentEvent a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutputSpentEvent a] -> ShowS
$cshowList :: forall a. Show a => [OutputSpentEvent a] -> ShowS
show :: OutputSpentEvent a -> String
$cshow :: forall a. Show a => OutputSpentEvent a -> String
showsPrec :: Int -> OutputSpentEvent a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> OutputSpentEvent a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (OutputSpentEvent a) x -> OutputSpentEvent a
forall a x. OutputSpentEvent a -> Rep (OutputSpentEvent a) x
$cto :: forall a x. Rep (OutputSpentEvent a) x -> OutputSpentEvent a
$cfrom :: forall a x. OutputSpentEvent a -> Rep (OutputSpentEvent a) x
Generic, forall a b. a -> OutputSpentEvent b -> OutputSpentEvent a
forall a b. (a -> b) -> OutputSpentEvent a -> OutputSpentEvent b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> OutputSpentEvent b -> OutputSpentEvent a
$c<$ :: forall a b. a -> OutputSpentEvent b -> OutputSpentEvent a
fmap :: forall a b. (a -> b) -> OutputSpentEvent a -> OutputSpentEvent b
$cfmap :: forall a b. (a -> b) -> OutputSpentEvent a -> OutputSpentEvent b
Functor, forall a. Eq a => a -> OutputSpentEvent a -> Bool
forall a. Num a => OutputSpentEvent a -> a
forall a. Ord a => OutputSpentEvent a -> a
forall m. Monoid m => OutputSpentEvent m -> m
forall a. OutputSpentEvent a -> Bool
forall a. OutputSpentEvent a -> Int
forall a. OutputSpentEvent a -> [a]
forall a. (a -> a -> a) -> OutputSpentEvent a -> a
forall m a. Monoid m => (a -> m) -> OutputSpentEvent a -> m
forall b a. (b -> a -> b) -> b -> OutputSpentEvent a -> b
forall a b. (a -> b -> b) -> b -> OutputSpentEvent a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => OutputSpentEvent a -> a
$cproduct :: forall a. Num a => OutputSpentEvent a -> a
sum :: forall a. Num a => OutputSpentEvent a -> a
$csum :: forall a. Num a => OutputSpentEvent a -> a
minimum :: forall a. Ord a => OutputSpentEvent a -> a
$cminimum :: forall a. Ord a => OutputSpentEvent a -> a
maximum :: forall a. Ord a => OutputSpentEvent a -> a
$cmaximum :: forall a. Ord a => OutputSpentEvent a -> a
elem :: forall a. Eq a => a -> OutputSpentEvent a -> Bool
$celem :: forall a. Eq a => a -> OutputSpentEvent a -> Bool
length :: forall a. OutputSpentEvent a -> Int
$clength :: forall a. OutputSpentEvent a -> Int
null :: forall a. OutputSpentEvent a -> Bool
$cnull :: forall a. OutputSpentEvent a -> Bool
toList :: forall a. OutputSpentEvent a -> [a]
$ctoList :: forall a. OutputSpentEvent a -> [a]
foldl1 :: forall a. (a -> a -> a) -> OutputSpentEvent a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> OutputSpentEvent a -> a
foldr1 :: forall a. (a -> a -> a) -> OutputSpentEvent a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> OutputSpentEvent a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> OutputSpentEvent a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> OutputSpentEvent a -> b
foldl :: forall b a. (b -> a -> b) -> b -> OutputSpentEvent a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> OutputSpentEvent a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> OutputSpentEvent a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> OutputSpentEvent a -> b
foldr :: forall a b. (a -> b -> b) -> b -> OutputSpentEvent a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> OutputSpentEvent a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> OutputSpentEvent a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> OutputSpentEvent a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> OutputSpentEvent a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> OutputSpentEvent a -> m
fold :: forall m. Monoid m => OutputSpentEvent m -> m
$cfold :: forall m. Monoid m => OutputSpentEvent m -> m
Foldable, Functor OutputSpentEvent
Foldable OutputSpentEvent
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
OutputSpentEvent (m a) -> m (OutputSpentEvent a)
forall (f :: * -> *) a.
Applicative f =>
OutputSpentEvent (f a) -> f (OutputSpentEvent a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> OutputSpentEvent a -> m (OutputSpentEvent b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OutputSpentEvent a -> f (OutputSpentEvent b)
sequence :: forall (m :: * -> *) a.
Monad m =>
OutputSpentEvent (m a) -> m (OutputSpentEvent a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
OutputSpentEvent (m a) -> m (OutputSpentEvent a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> OutputSpentEvent a -> m (OutputSpentEvent b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> OutputSpentEvent a -> m (OutputSpentEvent b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
OutputSpentEvent (f a) -> f (OutputSpentEvent a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
OutputSpentEvent (f a) -> f (OutputSpentEvent a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OutputSpentEvent a -> f (OutputSpentEvent b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OutputSpentEvent a -> f (OutputSpentEvent b)
Traversable)

data NewOutputEvent a =
  NewOutputEvent
    { forall a. NewOutputEvent a -> TxId
neTransaction :: !TxId
    , forall a. NewOutputEvent a -> a
neEvent       :: !a
    , forall a. NewOutputEvent a -> TxIx
neTxIx        :: !TxIx
    , forall a. NewOutputEvent a -> ScriptOut
neOutput      :: !ScriptOut
    , forall a. NewOutputEvent a -> Maybe (Data StandardBabbage)
neDatum       :: !(Maybe (Data ERA))
    , forall a. NewOutputEvent a -> Integer
neBlockNo     :: !Integer
    , forall a. NewOutputEvent a -> SlotNo
neSlot        :: !SlotNo
    , forall a. NewOutputEvent a -> ScriptHash
neScriptHash  :: !ScriptHash
    , forall a. NewOutputEvent a -> ScriptOutDataHash
neDataHash    :: !ScriptOutDataHash
    , forall a. NewOutputEvent a -> [KeyHash 'Witness StandardCrypto]
neSigners     :: ![KeyHash 'Witness StandardCrypto]
    , forall a. NewOutputEvent a -> Map Word64 Metadatum
neTxMetadata  :: !(Map Word64 Metadatum)
    } deriving stock (NewOutputEvent a -> NewOutputEvent a -> Bool
forall a. Eq a => NewOutputEvent a -> NewOutputEvent a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewOutputEvent a -> NewOutputEvent a -> Bool
$c/= :: forall a. Eq a => NewOutputEvent a -> NewOutputEvent a -> Bool
== :: NewOutputEvent a -> NewOutputEvent a -> Bool
$c== :: forall a. Eq a => NewOutputEvent a -> NewOutputEvent a -> Bool
Eq, Int -> NewOutputEvent a -> ShowS
forall a. Show a => Int -> NewOutputEvent a -> ShowS
forall a. Show a => [NewOutputEvent a] -> ShowS
forall a. Show a => NewOutputEvent a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NewOutputEvent a] -> ShowS
$cshowList :: forall a. Show a => [NewOutputEvent a] -> ShowS
show :: NewOutputEvent a -> String
$cshow :: forall a. Show a => NewOutputEvent a -> String
showsPrec :: Int -> NewOutputEvent a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> NewOutputEvent a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (NewOutputEvent a) x -> NewOutputEvent a
forall a x. NewOutputEvent a -> Rep (NewOutputEvent a) x
$cto :: forall a x. Rep (NewOutputEvent a) x -> NewOutputEvent a
$cfrom :: forall a x. NewOutputEvent a -> Rep (NewOutputEvent a) x
Generic, forall a b. a -> NewOutputEvent b -> NewOutputEvent a
forall a b. (a -> b) -> NewOutputEvent a -> NewOutputEvent b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> NewOutputEvent b -> NewOutputEvent a
$c<$ :: forall a b. a -> NewOutputEvent b -> NewOutputEvent a
fmap :: forall a b. (a -> b) -> NewOutputEvent a -> NewOutputEvent b
$cfmap :: forall a b. (a -> b) -> NewOutputEvent a -> NewOutputEvent b
Functor, forall a. Eq a => a -> NewOutputEvent a -> Bool
forall a. Num a => NewOutputEvent a -> a
forall a. Ord a => NewOutputEvent a -> a
forall m. Monoid m => NewOutputEvent m -> m
forall a. NewOutputEvent a -> Bool
forall a. NewOutputEvent a -> Int
forall a. NewOutputEvent a -> [a]
forall a. (a -> a -> a) -> NewOutputEvent a -> a
forall m a. Monoid m => (a -> m) -> NewOutputEvent a -> m
forall b a. (b -> a -> b) -> b -> NewOutputEvent a -> b
forall a b. (a -> b -> b) -> b -> NewOutputEvent a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => NewOutputEvent a -> a
$cproduct :: forall a. Num a => NewOutputEvent a -> a
sum :: forall a. Num a => NewOutputEvent a -> a
$csum :: forall a. Num a => NewOutputEvent a -> a
minimum :: forall a. Ord a => NewOutputEvent a -> a
$cminimum :: forall a. Ord a => NewOutputEvent a -> a
maximum :: forall a. Ord a => NewOutputEvent a -> a
$cmaximum :: forall a. Ord a => NewOutputEvent a -> a
elem :: forall a. Eq a => a -> NewOutputEvent a -> Bool
$celem :: forall a. Eq a => a -> NewOutputEvent a -> Bool
length :: forall a. NewOutputEvent a -> Int
$clength :: forall a. NewOutputEvent a -> Int
null :: forall a. NewOutputEvent a -> Bool
$cnull :: forall a. NewOutputEvent a -> Bool
toList :: forall a. NewOutputEvent a -> [a]
$ctoList :: forall a. NewOutputEvent a -> [a]
foldl1 :: forall a. (a -> a -> a) -> NewOutputEvent a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> NewOutputEvent a -> a
foldr1 :: forall a. (a -> a -> a) -> NewOutputEvent a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> NewOutputEvent a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> NewOutputEvent a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> NewOutputEvent a -> b
foldl :: forall b a. (b -> a -> b) -> b -> NewOutputEvent a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> NewOutputEvent a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> NewOutputEvent a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> NewOutputEvent a -> b
foldr :: forall a b. (a -> b -> b) -> b -> NewOutputEvent a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> NewOutputEvent a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> NewOutputEvent a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> NewOutputEvent a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> NewOutputEvent a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> NewOutputEvent a -> m
fold :: forall m. Monoid m => NewOutputEvent m -> m
$cfold :: forall m. Monoid m => NewOutputEvent m -> m
Foldable, Functor NewOutputEvent
Foldable NewOutputEvent
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
NewOutputEvent (m a) -> m (NewOutputEvent a)
forall (f :: * -> *) a.
Applicative f =>
NewOutputEvent (f a) -> f (NewOutputEvent a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NewOutputEvent a -> m (NewOutputEvent b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NewOutputEvent a -> f (NewOutputEvent b)
sequence :: forall (m :: * -> *) a.
Monad m =>
NewOutputEvent (m a) -> m (NewOutputEvent a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
NewOutputEvent (m a) -> m (NewOutputEvent a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NewOutputEvent a -> m (NewOutputEvent b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NewOutputEvent a -> m (NewOutputEvent b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
NewOutputEvent (f a) -> f (NewOutputEvent a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
NewOutputEvent (f a) -> f (NewOutputEvent a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NewOutputEvent a -> f (NewOutputEvent b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NewOutputEvent a -> f (NewOutputEvent b)
Traversable)

{-| The 'TxIn' of the new output
-}
txIn :: NewOutputEvent a -> TxIn
txIn :: forall a. NewOutputEvent a -> TxIn
txIn NewOutputEvent{TxId
neTransaction :: TxId
neTransaction :: forall a. NewOutputEvent a -> TxId
neTransaction, TxIx
neTxIx :: TxIx
neTxIx :: forall a. NewOutputEvent a -> TxIx
neTxIx} = TxId -> TxIx -> TxIn
TxIn TxId
neTransaction TxIx
neTxIx

newtype ResolvedInputs a = ResolvedInputs (Map TxIn (NewOutputEvent a))
  deriving stock (ResolvedInputs a -> ResolvedInputs a -> Bool
forall a. Eq a => ResolvedInputs a -> ResolvedInputs a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResolvedInputs a -> ResolvedInputs a -> Bool
$c/= :: forall a. Eq a => ResolvedInputs a -> ResolvedInputs a -> Bool
== :: ResolvedInputs a -> ResolvedInputs a -> Bool
$c== :: forall a. Eq a => ResolvedInputs a -> ResolvedInputs a -> Bool
Eq, Int -> ResolvedInputs a -> ShowS
forall a. Show a => Int -> ResolvedInputs a -> ShowS
forall a. Show a => [ResolvedInputs a] -> ShowS
forall a. Show a => ResolvedInputs a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResolvedInputs a] -> ShowS
$cshowList :: forall a. Show a => [ResolvedInputs a] -> ShowS
show :: ResolvedInputs a -> String
$cshow :: forall a. Show a => ResolvedInputs a -> String
showsPrec :: Int -> ResolvedInputs a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ResolvedInputs a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ResolvedInputs a) x -> ResolvedInputs a
forall a x. ResolvedInputs a -> Rep (ResolvedInputs a) x
$cto :: forall a x. Rep (ResolvedInputs a) x -> ResolvedInputs a
$cfrom :: forall a x. ResolvedInputs a -> Rep (ResolvedInputs a) x
Generic)
  deriving newtype (NonEmpty (ResolvedInputs a) -> ResolvedInputs a
ResolvedInputs a -> ResolvedInputs a -> ResolvedInputs a
forall b. Integral b => b -> ResolvedInputs a -> ResolvedInputs a
forall a. NonEmpty (ResolvedInputs a) -> ResolvedInputs a
forall a. ResolvedInputs a -> ResolvedInputs a -> ResolvedInputs a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> ResolvedInputs a -> ResolvedInputs a
stimes :: forall b. Integral b => b -> ResolvedInputs a -> ResolvedInputs a
$cstimes :: forall a b. Integral b => b -> ResolvedInputs a -> ResolvedInputs a
sconcat :: NonEmpty (ResolvedInputs a) -> ResolvedInputs a
$csconcat :: forall a. NonEmpty (ResolvedInputs a) -> ResolvedInputs a
<> :: ResolvedInputs a -> ResolvedInputs a -> ResolvedInputs a
$c<> :: forall a. ResolvedInputs a -> ResolvedInputs a -> ResolvedInputs a
Semigroup, ResolvedInputs a
[ResolvedInputs a] -> ResolvedInputs a
ResolvedInputs a -> ResolvedInputs a -> ResolvedInputs a
forall a. Semigroup (ResolvedInputs a)
forall a. ResolvedInputs a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [ResolvedInputs a] -> ResolvedInputs a
forall a. ResolvedInputs a -> ResolvedInputs a -> ResolvedInputs a
mconcat :: [ResolvedInputs a] -> ResolvedInputs a
$cmconcat :: forall a. [ResolvedInputs a] -> ResolvedInputs a
mappend :: ResolvedInputs a -> ResolvedInputs a -> ResolvedInputs a
$cmappend :: forall a. ResolvedInputs a -> ResolvedInputs a -> ResolvedInputs a
mempty :: ResolvedInputs a
$cmempty :: forall a. ResolvedInputs a
Monoid)

extract ::
  Extract a
  -> ResolvedInputs a -- ^ Resolved inputs
  -> BlockInMode CardanoMode -- ^ New block
  -> ([TxWithEvents a], ResolvedInputs a) -- ^ Defi events extracted from block
extract :: forall a.
Extract a
-> ResolvedInputs a
-> BlockInMode CardanoMode
-> ([TxWithEvents a], ResolvedInputs a)
extract Extract a
ex ResolvedInputs a
resolvedInputs = \case
  BlockInMode Block era
block EraInMode era CardanoMode
BabbageEraInCardanoMode -> forall a.
Extract a
-> ResolvedInputs a
-> Block BabbageEra
-> ([TxWithEvents a], ResolvedInputs a)
extractBabbageBlock Extract a
ex ResolvedInputs a
resolvedInputs Block era
block
  BlockInMode CardanoMode
_                                        -> ([], ResolvedInputs a
resolvedInputs)

extractBabbageBlock :: Extract a -> ResolvedInputs a -> Block BabbageEra -> ([TxWithEvents a], ResolvedInputs a)
extractBabbageBlock :: forall a.
Extract a
-> ResolvedInputs a
-> Block BabbageEra
-> ([TxWithEvents a], ResolvedInputs a)
extractBabbageBlock Extract a
ex ResolvedInputs a
resolvedInputs (Block BlockHeader
blockHeader [Tx BabbageEra]
txns) =
  forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> (a, s)
runState ResolvedInputs a
resolvedInputs forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a (m :: * -> *).
MonadState (ResolvedInputs a) m =>
Extract a
-> BlockHeader -> Tx BabbageEra -> m (Maybe (TxWithEvents a))
extractBabbageTxn Extract a
ex BlockHeader
blockHeader) [Tx BabbageEra]
txns

type ScriptOut = Babbage.TxBody.BabbageTxOut (Babbage.BabbageEra StandardCrypto)

extractBabbageTxn' :: ResolvedInputs a -> Extract a -> BlockHeader -> Tx BabbageEra -> ([TxWithEvents a], ResolvedInputs a)
extractBabbageTxn' :: forall a.
ResolvedInputs a
-> Extract a
-> BlockHeader
-> Tx BabbageEra
-> ([TxWithEvents a], ResolvedInputs a)
extractBabbageTxn' ResolvedInputs a
resolvedInputs Extract a
ex BlockHeader
blockHeader Tx BabbageEra
tx =
  forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ forall s a. State s a -> s -> (a, s)
runState (forall a (m :: * -> *).
MonadState (ResolvedInputs a) m =>
Extract a
-> BlockHeader -> Tx BabbageEra -> m (Maybe (TxWithEvents a))
extractBabbageTxn Extract a
ex BlockHeader
blockHeader Tx BabbageEra
tx) ResolvedInputs a
resolvedInputs

extractBabbageTxn :: forall a m. MonadState (ResolvedInputs a) m => Extract a -> BlockHeader -> Tx BabbageEra -> m (Maybe (TxWithEvents a))
extractBabbageTxn :: forall a (m :: * -> *).
MonadState (ResolvedInputs a) m =>
Extract a
-> BlockHeader -> Tx BabbageEra -> m (Maybe (TxWithEvents a))
extractBabbageTxn Extract a
ex (C.BlockHeader SlotNo
slotNo Hash BlockHeader
_ twBlock :: BlockNo
twBlock@(C.BlockNo Word64
blockNo)) twTx :: Tx BabbageEra
twTx@(Tx TxBody BabbageEra
txBody [KeyWitness BabbageEra]
keyWitnesses) = do
  ResolvedInputs Map TxIn (NewOutputEvent a)
resolvedInputs <- forall s (m :: * -> *). MonadState s m => m s
get
  let txId :: TxId
txId = forall era. TxBody era -> TxId
C.getTxId TxBody BabbageEra
txBody
      ShelleyTxBody ShelleyBasedEra BabbageEra
_ TxBody (ShelleyLedgerEra BabbageEra)
txBody' [Script (ShelleyLedgerEra BabbageEra)]
_scripts TxBodyScriptData BabbageEra
scriptData Maybe (TxAuxData (ShelleyLedgerEra BabbageEra))
auxiliaryData TxScriptValidity BabbageEra
_ = TxBody BabbageEra
txBody
      Babbage.TxBody.BabbageTxBody{StrictSeq (Sized (TxOut StandardBabbage))
btbOutputs :: forall era.
BabbageEraTxBody era =>
BabbageTxBody era -> StrictSeq (Sized (TxOut era))
btbOutputs :: StrictSeq (Sized (TxOut StandardBabbage))
Babbage.TxBody.btbOutputs, Set (TxIn (EraCrypto StandardBabbage))
btbInputs :: forall era.
BabbageEraTxBody era =>
BabbageTxBody era -> Set (TxIn (EraCrypto era))
btbInputs :: Set (TxIn (EraCrypto StandardBabbage))
Babbage.TxBody.btbInputs} = TxBody (ShelleyLedgerEra BabbageEra)
txBody'
      TxWitness.TxDats' Map ScriptOutDataHash (Data StandardBabbage)
txDats = case TxBodyScriptData BabbageEra
scriptData of
        C.TxBodyScriptData ScriptDataSupportedInEra BabbageEra
C.ScriptDataInBabbageEra TxDats (ShelleyLedgerEra BabbageEra)
txDats' Redeemers (ShelleyLedgerEra BabbageEra)
_ -> TxDats (ShelleyLedgerEra BabbageEra)
txDats'
        TxBodyScriptData BabbageEra
_                                                     -> forall a. Monoid a => a
mempty
      txReds :: Map RdmrPtr (Data StandardBabbage, ExUnits)
txReds = case TxBodyScriptData BabbageEra
scriptData of
        C.TxBodyScriptData ScriptDataSupportedInEra BabbageEra
C.ScriptDataInBabbageEra TxDats (ShelleyLedgerEra BabbageEra)
_ (TxWitness.Redeemers Map RdmrPtr (Data StandardBabbage, ExUnits)
txReds') -> Map RdmrPtr (Data StandardBabbage, ExUnits)
txReds'
        TxBodyScriptData BabbageEra
_                                                                          -> forall a. Monoid a => a
mempty

      capiTxOuts :: [TxOut CtxTx BabbageEra]
capiTxOuts = forall era.
ShelleyBasedEra era
-> TxBody (ShelleyLedgerEra era)
-> TxBodyScriptData era
-> [TxOut CtxTx era]
C.fromLedgerTxOuts ShelleyBasedEra BabbageEra
C.ShelleyBasedEraBabbage TxBody (ShelleyLedgerEra BabbageEra)
txBody' TxBodyScriptData BabbageEra
scriptData

      mapOutput :: TxIx -> (ScriptOut, C.TxOut C.CtxTx C.BabbageEra) -> Maybe (ScriptHash, ScriptOut, TxIx, ScriptOutDataHash, a)
      mapOutput :: TxIx
-> (ScriptOut, TxOut CtxTx BabbageEra)
-> Maybe (ScriptHash, ScriptOut, TxIx, ScriptOutDataHash, a)
mapOutput TxIx
ix (scriptOut :: ScriptOut
scriptOut@(Cardano.Ledger.Babbage.TxOut.BabbageTxOut Addr (EraCrypto StandardBabbage)
address Value StandardBabbage
_value (Babbage.TxBody.DatumHash ScriptOutDataHash
dataHash) StrictMaybe (Script StandardBabbage)
_), TxOut CtxTx BabbageEra
capiOut) = case Addr (EraCrypto StandardBabbage)
address of -- FIXME: Could also be Datum?
          Address.Addr Network
_network PaymentCredential (EraCrypto StandardBabbage)
paymentCredential StakeReference (EraCrypto StandardBabbage)
_stakeReference -> case PaymentCredential (EraCrypto StandardBabbage)
paymentCredential of
              Credential.ScriptHashObj ScriptHash (EraCrypto StandardBabbage)
hsh ->
                  let hsh' :: ScriptHash
hsh' = ScriptHash StandardCrypto -> ScriptHash
CS.fromShelleyScriptHash ScriptHash (EraCrypto StandardBabbage)
hsh in
                  case Extract a
ex TxOut CtxTx BabbageEra
capiOut ScriptHash
hsh' of
                    Just a
a  -> forall a. a -> Maybe a
Just (ScriptHash
hsh', ScriptOut
scriptOut, TxIx
ix, ScriptOutDataHash
dataHash, a
a)
                    Maybe a
Nothing -> forall a. Maybe a
Nothing
              PaymentCredential (EraCrypto StandardBabbage)
_ -> forall a. Maybe a
Nothing
          Addr (EraCrypto StandardBabbage)
_ -> forall a. Maybe a
Nothing
      mapOutput TxIx
_ (ScriptOut, TxOut CtxTx BabbageEra)
_ = forall a. Maybe a
Nothing

      relevantOutputs :: [(ScriptHash, ScriptOut, TxIx, DataHash StandardCrypto, a)]
relevantOutputs = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxIx
-> (ScriptOut, TxOut CtxTx BabbageEra)
-> Maybe (ScriptHash, ScriptOut, TxIx, ScriptOutDataHash, a)
mapOutput) (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Enum a => Int -> a
toEnum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0..]) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. Sized a -> a
Cardano.Ledger.Binary.sizedValue) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (Sized (TxOut StandardBabbage))
btbOutputs) [TxOut CtxTx BabbageEra]
capiTxOuts))

      outputEvents :: [NewOutputEvent a]
      outputEvents :: [NewOutputEvent a]
outputEvents = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ScriptHash, ScriptOut, TxIx, DataHash StandardCrypto, a)
-> NewOutputEvent a
mkEvent [(ScriptHash, ScriptOut, TxIx, DataHash StandardCrypto, a)]
relevantOutputs where
        mkEvent :: (ScriptHash, ScriptOut, TxIx, DataHash StandardCrypto, a)
-> NewOutputEvent a
mkEvent (ScriptHash
neScriptHash, ScriptOut
neOutput, TxIx
neTxIx, DataHash StandardCrypto
neDataHash, a
neEvent) =
            let neDatum :: Maybe (Data StandardBabbage)
neDatum = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DataHash StandardCrypto
neDataHash Map ScriptOutDataHash (Data StandardBabbage)
txDats
            in NewOutputEvent
                { neTransaction :: TxId
neTransaction = TxId
txId
                , TxIx
neTxIx :: TxIx
neTxIx :: TxIx
neTxIx
                , a
neEvent :: a
neEvent :: a
neEvent
                , ScriptOut
neOutput :: ScriptOut
neOutput :: ScriptOut
neOutput
                , neBlockNo :: Integer
neBlockNo = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
blockNo
                , neSlot :: SlotNo
neSlot = SlotNo
slotNo
                , ScriptHash
neScriptHash :: ScriptHash
neScriptHash :: ScriptHash
neScriptHash
                , Maybe (Data StandardBabbage)
neDatum :: Maybe (Data StandardBabbage)
neDatum :: Maybe (Data StandardBabbage)
neDatum
                , DataHash StandardCrypto
neDataHash :: DataHash StandardCrypto
neDataHash :: ScriptOutDataHash
neDataHash
                , neSigners :: [KeyHash 'Witness StandardCrypto]
neSigners = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe KeyWitness BabbageEra -> Maybe (KeyHash 'Witness StandardCrypto)
getKeyWitness [KeyWitness BabbageEra]
keyWitnesses
                , neTxMetadata :: Map Word64 Metadatum
neTxMetadata = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\(AlonzoTxAuxData Map Word64 Metadatum
meta StrictSeq (Timelock StandardBabbage)
_ Map Language (NonEmpty BinaryPlutus)
_) -> Map Word64 Metadatum
meta) Maybe (TxAuxData (ShelleyLedgerEra BabbageEra))
auxiliaryData
                }

      outputSpentEvents :: [OutputSpentEvent a]
      outputSpentEvents :: [OutputSpentEvent a]
outputSpentEvents =
        -- there should always be a redeemer
        -- because we only look at inputs that spend script outputs
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Word64
idx, TxIn
oseTxIn, NewOutputEvent a
oseTxOutput) -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"outputSpentEvents: Redeemer or datum not found: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Word64
idx) (\((Data StandardBabbage
oseRedeemer, ExUnits
_), Data StandardBabbage
oseDatum) -> OutputSpentEvent{TxIn
oseTxIn :: TxIn
oseTxIn :: TxIn
oseTxIn, NewOutputEvent a
oseTxOutput :: NewOutputEvent a
oseTxOutput :: NewOutputEvent a
oseTxOutput, Data StandardBabbage
oseRedeemer :: Data StandardBabbage
oseRedeemer :: Data StandardBabbage
oseRedeemer, Data StandardBabbage
oseDatum :: Data StandardBabbage
oseDatum :: Data StandardBabbage
oseDatum, oseSpendingTx :: TxId
oseSpendingTx=TxId
txId}) forall a b. (a -> b) -> a -> b
$ ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Tag -> Word64 -> RdmrPtr
TxWitness.RdmrPtr Tag
Scripts.Spend Word64
idx) Map RdmrPtr (Data StandardBabbage, ExUnits)
txReds) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall a. NewOutputEvent a -> ScriptOutDataHash
neDataHash NewOutputEvent a
oseTxOutput) Map ScriptOutDataHash (Data StandardBabbage)
txDats)
        forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Word64
idx, TxIn
oseTxIn) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word64
idx, TxIn
oseTxIn,) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn
oseTxIn Map TxIn (NewOutputEvent a)
resolvedInputs)
        forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Word64
0..]
        forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxId -> TxIx -> TxIn
TxIn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TxId StandardCrypto -> TxId
CS.fromShelleyTxId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second TxIx -> TxIx
txIx forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(CT.TxIn TxId StandardCrypto
i TxIx
n) -> (TxId StandardCrypto
i, TxIx
n)))
        forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a. a -> a
id
        forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set (TxIn (EraCrypto StandardBabbage))
btbInputs

      resolvedInputsDeleted :: ResolvedInputs a
resolvedInputsDeleted = forall a. Map TxIn (NewOutputEvent a) -> ResolvedInputs a
ResolvedInputs (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map TxIn (NewOutputEvent a)
inp OutputSpentEvent{TxIn
oseTxIn :: TxIn
oseTxIn :: forall a. OutputSpentEvent a -> TxIn
oseTxIn} -> forall k a. Ord k => k -> Map k a -> Map k a
Map.delete TxIn
oseTxIn Map TxIn (NewOutputEvent a)
inp) Map TxIn (NewOutputEvent a)
resolvedInputs [OutputSpentEvent a]
outputSpentEvents)

      newResolvedInputs :: ResolvedInputs a
newResolvedInputs = forall a. Map TxIn (NewOutputEvent a) -> ResolvedInputs a
ResolvedInputs forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\e :: NewOutputEvent a
e@NewOutputEvent{TxId
neTransaction :: TxId
neTransaction :: forall a. NewOutputEvent a -> TxId
neTransaction, TxIx
neTxIx :: TxIx
neTxIx :: forall a. NewOutputEvent a -> TxIx
neTxIx} -> (TxId -> TxIx -> TxIn
TxIn TxId
neTransaction TxIx
neTxIx, NewOutputEvent a
e)) [NewOutputEvent a]
outputEvents
  forall s (m :: * -> *). MonadState s m => s -> m ()
put (ResolvedInputs a
newResolvedInputs forall a. Semigroup a => a -> a -> a
<> ResolvedInputs a
resolvedInputsDeleted)
  let newEvents :: [Event a]
newEvents = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. NewOutputEvent a -> Event a
ANewOutputEvent [NewOutputEvent a]
outputEvents forall a. [a] -> [a] -> [a]
++ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. OutputSpentEvent a -> Event a
AnOutputSpentEvent [OutputSpentEvent a]
outputSpentEvents
  case [Event a]
newEvents of
    []     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    (Event a
y:[Event a]
ys) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just TxWithEvents{Tx BabbageEra
twTx :: Tx BabbageEra
twTx :: Tx BabbageEra
twTx, twEvents :: NonEmpty (Event a)
twEvents = Event a
y forall a. a -> [a] -> NonEmpty a
:| [Event a]
ys, twSlot :: SlotNo
twSlot = SlotNo
slotNo, BlockNo
twBlock :: BlockNo
twBlock :: BlockNo
twBlock })

convertScript :: Scripts.Script ERA -> Maybe (C.Script C.PlutusScriptV1)
convertScript :: Script StandardBabbage -> Maybe (Script PlutusScriptV1)
convertScript = \case
    Scripts.TimelockScript{}          -> forall a. Maybe a
Nothing
    Scripts.PlutusScript Language
_language ShortByteString
bs -> forall a. a -> Maybe a
Just (forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
C.PlutusScript PlutusScriptVersion PlutusScriptV1
C.PlutusScriptV1 (forall lang. ShortByteString -> PlutusScript lang
CS.PlutusScriptSerialised ShortByteString
bs))

getKeyWitness :: C.KeyWitness BabbageEra -> Maybe (KeyHash 'Witness StandardCrypto)
getKeyWitness :: KeyWitness BabbageEra -> Maybe (KeyHash 'Witness StandardCrypto)
getKeyWitness = \case
  CS.ShelleyKeyWitness ShelleyBasedEra BabbageEra
_era WitVKey 'Witness StandardCrypto
withVKey -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (kr :: KeyRole) c. WitVKey kr c -> KeyHash 'Witness c
witVKeyHash WitVKey 'Witness StandardCrypto
withVKey
  KeyWitness BabbageEra
_                                  -> forall a. Maybe a
Nothing

txIx :: CT.TxIx -> TxIx
txIx :: TxIx -> TxIx
txIx (CT.TxIx Word64
i) = Word -> TxIx
TxIx (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i)